R/plotDataSetList.R

Defines functions plot_eaf_data Plot.cumulative_difference_plot Plot.Performviz plot_general_data add_transparancy Plot.Stats.Glicko2_Candlestick.DataSetList Plot.Stats.Significance_Graph.DataSetList radian.rescale Plot.Comparison.Heatmap.DataSetList Plot.Stats.Significance_Heatmap.DataSetList Plot.FV.Aggregated.DataSetList Plot.RT.Aggregated.DataSetList Plot.FV.Multi_Func.DataSetList Plot.RT.Multi_Func.DataSetList Plot.RT.ECDF_Multi_Func.DataSetList Plot.FV.Parameters.DataSetList Plot.RT.Parameters.DataSetList Plot.FV.ECDF_AUC.DataSetList Plot.FV.ECDF_Single_Func.DataSetList Plot.FV.ECDF_Per_Target.DataSetList Plot.FV.Histogram.DataSetList Plot.FV.PDF.DataSetList Plot.RT.ECDF_AUC.DataSetList Plot.RT.ECDF_Single_Func.DataSetList Plot.RT.ECDF_Per_Target.DataSetList Plot.RT.Histogram.DataSetList Plot.RT.PMF.DataSetList Plot.FV.Single_Func.DataSetList Plot.RT.Single_Func.DataSetList Plot.Stats.Glicko2_Candlestick Plot.Stats.Significance_Graph Plot.Comparison.Heatmap Plot.Stats.Significance_Heatmap Plot.FV.Multi_Func Plot.FV.Aggregated Plot.RT.Aggregated Plot.RT.Multi_Func Plot.RT.ECDF_Multi_Func Plot.FV.Parameters Plot.RT.Parameters Plot.FV.ECDF_AUC Plot.FV.ECDF_Single_Func Plot.FV.ECDF_Per_Target Plot.FV.Histogram Plot.FV.PDF Plot.RT.ECDF_AUC Plot.RT.ECDF_Single_Func Plot.RT.ECDF_Per_Target Plot.RT.Histogram Plot.RT.PMF Plot.FV.Single_Func Plot.RT.Single_Func generate_rbga insert_best_parts get_legends

Documented in Plot.Comparison.Heatmap Plot.Comparison.Heatmap.DataSetList Plot.cumulative_difference_plot plot_eaf_data Plot.FV.Aggregated Plot.FV.Aggregated.DataSetList Plot.FV.ECDF_AUC Plot.FV.ECDF_AUC.DataSetList Plot.FV.ECDF_Per_Target Plot.FV.ECDF_Per_Target.DataSetList Plot.FV.ECDF_Single_Func Plot.FV.ECDF_Single_Func.DataSetList Plot.FV.Histogram Plot.FV.Histogram.DataSetList Plot.FV.Multi_Func Plot.FV.Multi_Func.DataSetList Plot.FV.Parameters Plot.FV.Parameters.DataSetList Plot.FV.PDF Plot.FV.PDF.DataSetList Plot.FV.Single_Func Plot.FV.Single_Func.DataSetList plot_general_data Plot.Performviz Plot.RT.Aggregated Plot.RT.Aggregated.DataSetList Plot.RT.ECDF_AUC Plot.RT.ECDF_AUC.DataSetList Plot.RT.ECDF_Multi_Func Plot.RT.ECDF_Multi_Func.DataSetList Plot.RT.ECDF_Per_Target Plot.RT.ECDF_Per_Target.DataSetList Plot.RT.ECDF_Single_Func Plot.RT.ECDF_Single_Func.DataSetList Plot.RT.Histogram Plot.RT.Histogram.DataSetList Plot.RT.Multi_Func Plot.RT.Multi_Func.DataSetList Plot.RT.Parameters Plot.RT.Parameters.DataSetList Plot.RT.PMF Plot.RT.PMF.DataSetList Plot.RT.Single_Func Plot.RT.Single_Func.DataSetList Plot.Stats.Glicko2_Candlestick Plot.Stats.Glicko2_Candlestick.DataSetList Plot.Stats.Significance_Graph Plot.Stats.Significance_Graph.DataSetList Plot.Stats.Significance_Heatmap Plot.Stats.Significance_Heatmap.DataSetList

symbols <-
  c(
    "circle-open",
    "diamond-open",
    "square-open",
    "cross-open",
    "triangle-up-open",
    "triangle-down-open"
  )

get_legends <- function(dsList) {
  N <- length(dsList)
  legends <- sapply(dsList, function(d)
    get_id(d))

  if (length(unique(legends)) < N) {
    funcId <- sapply(dsList, function(d)
      attr(d, 'funcId'))
    if (length(unique(funcId)) > 1)
      legends <- paste0(legends, '-F', funcId)
  }

  if (length(unique(legends)) < N) {
    DIM <- sapply(dsList, function(d)
      attr(d, 'DIM'))
    if (length(unique(DIM)) > 1)
      legends <- paste0(legends, '-', DIM, 'D')
  }
  legends
}

insert_best_parts <- function(from_data, to_data, best_is_min) {
  if (all(is.na(from_data)))
    to_data
  else
    if (best_is_min)
      pmin(from_data, to_data, na.rm = T)
  else
    pmax(from_data, to_data, na.rm = T)
}

generate_rbga <- function(color, a) {
  paste0('rgba(', paste0(color, collapse = ','), ',', a, ')')
}

grad_functions <- c(
  scaled_edges = function(count, amount, intensity) {
    scale <- (intensity + 1) / 2
    color_end <- floor(scale * amount * 2)
    if (count < color_end)
      1 / color_end
    else
      0
  }
  ,
  fixed_edges = function(count, amount, intensity) {
    scale <- (intensity + 1) / 2
    color_center <- floor(scale * amount) + 1
    if (count <= color_center)
      1 / (2 * color_center)
    else
      1 / (2 * (amount - color_center))
  }
)

#S3 generics
# TODO: decide which parameters need to be in the generics

#' Plot lineplot of the ERTs of a DataSetList
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param Fstart The starting function value.
#' @param Fstop The final function value.
#' @param show.ERT Whether or not to show the ERT-values
#' @param show.CI Whether or not to show the standard deviations
#' @param show.mean Whether or not to show the mean hitting times
#' @param show.median Whether or not to show the median hitting times
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param scale.reverse Wheter or not to reverse the x-axis (when using minimization)
#' @param backend Which plotting library to use. Can be 'plotly' or 'ggplot2'
#' @param includeOpts Whether or not to include all best points reached by each algorithm
#' @param p Existing plot to which to add the current data
#' @return A plot of ERT-values of the DataSetList
#' @export
#' @examples
#' Plot.RT.Single_Func(subset(dsl, funcId == 1))
Plot.RT.Single_Func <- function(dsList,
                                Fstart = NULL,
                                Fstop = NULL,
                                show.ERT = T,
                                show.CI = F,
                                show.mean = F,
                                show.median = F,
                                backend = NULL,
                                scale.xlog = F,
                                scale.ylog = F,
                                scale.reverse = F,
                                includeOpts = F,
                                p = NULL)
UseMethod("Plot.RT.Single_Func", dsList)
#' Plot lineplot of the expected function values of a DataSetList
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param RTstart The starting runtime value.
#' @param RTstop The final runtime value.
#' @param show.CI Whether or not to show the standard deviations
#' @param show.mean Whether or not to show the mean runtimes
#' @param show.median Whether or not to show the median runtimes
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param scale.reverse Wheter or not to reverse the x-axis (when using minimization)
#' @param backend Which plotting library to use. Can be 'plotly' or 'ggplot2'
#'
#' @return A plot of ERT-values of the DataSetList
#' @export
#' @examples
#' Plot.FV.Single_Func(subset(dsl, funcId == 1))
Plot.FV.Single_Func <-
  function(dsList,
           RTstart = NULL,
           RTstop = NULL,
           show.CI = F,
           show.mean = T,
           show.median = F,
           backend = NULL,
           scale.xlog = F,
           scale.ylog = F,
           scale.reverse = F)
    UseMethod("Plot.FV.Single_Func", dsList)
#' Plot probablity mass function of the runtimes of a DataSetList at a certain target function value
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param ftarget The target function value.
#' @param show.sample Whether or not to show the individual runtime samples
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param backend Which plotting library to use. Can be 'plotly' or 'ggplot2'
#'
#' @return A plot of the probablity mass function of the runtimes at a the
#'         target function value of the DataSetList
#' @export
#' @examples
#' Plot.RT.PMF(subset(dsl, funcId == 1), 14)
Plot.RT.PMF <-
  function(dsList,
           ftarget,
           show.sample = F,
           scale.ylog = F,
           backend = NULL)
    UseMethod("Plot.RT.PMF", dsList)
#' Plot histograms of the runtimes of a DataSetList at a certain target function value
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param ftarget The target function value.
#' @param plot_mode How to plot the different hisograms for each algorithm. Can be either
#'  'overlay' to show all algorithms on one plot, or 'subplot' to have one plot per algorithm.
#' @param use.equal.bins Whether to determine one bin size for all plots or have individual
#' bin sizes for each algorithm
#'
#' @return A plot of the histograms of the runtimes at a the
#'         target function value of the DataSetList
#' @export
#' @examples
#' Plot.RT.Histogram(subset(dsl, funcId == 1), 14)
Plot.RT.Histogram <-
  function(dsList,
           ftarget,
           plot_mode = 'overlay',
           use.equal.bins = F)
    UseMethod("Plot.RT.Histogram", dsList)
#' Plot the empirical cumulative distriburtion as a function of the running times of
#' a DataSetList at certain target function values
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param ftargets The target function values
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#'
#' @return A plot of the empirical cumulative distriburtion as a function of
#' the running times of the DataSetList at the target function values
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.RT.ECDF_Per_Target(subset(dsl, funcId == 1), 14)
Plot.RT.ECDF_Per_Target <-
  function(dsList, ftargets, scale.xlog = F)
    UseMethod("Plot.RT.ECDF_Per_Target", dsList)
#' Plot the aggregated empirical cumulative distriburtion as a function of the running times of
#' a DataSetList.
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param fstart The starting function value
#' @param fstop The final function value
#' @param fstep The spacing between starting and final function values
#' @param show.per_target Whether or not to show the individual ECDF-curves for each target
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#'
#' @return A plot of the empirical cumulative distriburtion as a function of
#' the running times of the DataSetList
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.RT.ECDF_Single_Func(subset(dsl, funcId == 1))
Plot.RT.ECDF_Single_Func <-
  function(dsList,
           fstart = NULL,
           fstop = NULL,
           fstep = NULL,
           show.per_target = F,
           scale.xlog = F)
    UseMethod("Plot.RT.ECDF_Single_Func", dsList)
#' Radarplot of the area under the aggregated ECDF-curve of a DataSetList.
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param fstart The starting function value
#' @param fstop The final function value
#' @param fstep The spacing between starting and final function values
#' @param fval_formatter Function to format the function-value labels
#'
#' @return A radarplot of the area under the aggregated ECDF-curve of the DataSetList
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.RT.ECDF_AUC(subset(dsl, funcId == 1))
Plot.RT.ECDF_AUC <- function(dsList,
                             fstart = NULL,
                             fstop = NULL,
                             fstep = NULL,
                             fval_formatter = as.integer)
  UseMethod("Plot.RT.ECDF_AUC", dsList)
#' Plot probablity density function of the function values of a DataSetList at
#' a certain target runtime
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param runtime The target runtime
#' @param show.sample Whether or not to show the individual function value samples
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#'
#' @return A plot of the probablity density function of the runtimes at a the
#'         target function value of the DataSetList
#' @export
#' @examples
#' Plot.FV.PDF(subset(dsl, funcId == 1), 100)
Plot.FV.PDF <-
  function(dsList,
           runtime,
           show.sample = F,
           scale.ylog = F)
    UseMethod("Plot.FV.PDF", dsList)
#' Plot histograms of the function values of a DataSetList at a certain target runtime
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param runtime The target runtime
#' @param plot_mode How to plot the different hisograms for each algorithm. Can be either
#'  'overlay' to show all algorithms on one plot, or 'subplot' to have one plot per algorithm.
#' @param use.equal.bins Whether to determine one bin size for all plots or have individual
#' bin sizes for each algorithm
#'
#' @return A plot of the histograms of the function values at a the
#'         target runtime of the DataSetList
#' @export
#' @examples
#' Plot.FV.Histogram(subset(dsl, funcId == 1), 100)
Plot.FV.Histogram <-
  function(dsList,
           runtime,
           plot_mode = 'overlay',
           use.equal.bins = F)
    UseMethod("Plot.FV.Histogram", dsList)
#' Plot the empirical cumulative distriburtion as a function of the target values of
#' a DataSetList at certain target runtimes
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param runtimes The target runtimes
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.reverse Whether or not to reverse the x-axis (when using minimization)
#'
#' @return A plot of the empirical cumulative distriburtion as a function of
#' the fucntion values of the DataSetList at the target runtimes
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.FV.ECDF_Per_Target(subset(dsl, funcId == 1), 10)
Plot.FV.ECDF_Per_Target <-
  function(dsList,
           runtimes,
           scale.xlog = F,
           scale.reverse = F)
    UseMethod("Plot.FV.ECDF_Per_Target", dsList)
#' Plot the aggregated empirical cumulative distriburtion as a function of the function values of
#' a DataSetList.
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param rt_min The starting runtime
#' @param rt_max The final runtime
#' @param rt_step The spacing between starting and final runtimes
#' @param show.per_target Whether or not to show the individual ECDF-curves for each runtime
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.reverse Whether or not to reverse the x-axis (when using minimization)
#'
#' @return A plot of the empirical cumulative distriburtion as a function of
#' the function values of the DataSetList
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.FV.ECDF_Single_Func(subset(dsl, funcId == 1))
Plot.FV.ECDF_Single_Func <-
  function(dsList,
           rt_min = NULL,
           rt_max = NULL,
           rt_step = NULL,
           scale.xlog = F,
           show.per_target = F,
           scale.reverse = F)
    UseMethod("Plot.FV.ECDF_Single_Func", dsList)
#' Radarplot of the area under the aggregated ECDF-curve of a DataSetList.
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param rt_min The starting runtime
#' @param rt_max The final runtime
#' @param rt_step The spacing between starting and final runtimes
#'
#' @return A radarplot of the area under the aggregated ECDF-curve of the DataSetList
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.FV.ECDF_AUC(subset(dsl, funcId == 1))
Plot.FV.ECDF_AUC <- function(dsList,
                             rt_min = NULL,
                             rt_max = NULL,
                             rt_step = NULL)
  UseMethod("Plot.FV.ECDF_AUC", dsList)
#' Plot the parameter values recorded in a DataSetList (aligned by funcion value)
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param f_min The starting function value.
#' @param f_max The final function value.
#' @param show.mean Whether or not to show the mean parameter values
#' @param show.median Whether or not to show the median parameter values
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param algids Which algorithms from dsList to use
#' @param par_name Which parameters to create plots for; set to NULL to use all
#' parameters found in dsList.
#' @param show.CI Whether or not to show the standard deviation
#'
#' @return A plot of for every recorded parameter in the DataSetList
#' @export
#' @examples
#' Plot.RT.Parameters(subset(dsl, funcId == 1))
Plot.RT.Parameters <- function(dsList,
                               f_min = NULL,
                               f_max = NULL,
                               algids = 'all',
                               par_name = NULL,
                               scale.xlog = F,
                               scale.ylog = F,
                               show.mean = T,
                               show.median = F,
                               show.CI = F)
  UseMethod("Plot.RT.Parameters", dsList)
#' Plot the parameter values recorded in a DataSetList (aligned by budget)
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param rt_min The starting budget value.
#' @param rt_max The final budget value.
#' @param show.mean Whether or not to show the mean parameter values
#' @param show.median Whether or not to show the median parameter values
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param algids Which algorithms from dsList to use
#' @param par_name Which parameters to create plots for; set to NULL to use all
#' parameters found in dsList.
#' @param show.CI Whether or not to show the standard deviation
#'
#' @return A plot of for every recorded parameter in the DataSetList
#' @export
#' @examples
#' Plot.FV.Parameters(subset(dsl, funcId == 1))
Plot.FV.Parameters <- function(dsList,
                               rt_min = NULL,
                               rt_max = NULL,
                               algids = 'all',
                               par_name = NULL,
                               scale.xlog = F,
                               scale.ylog = F,
                               show.mean = T,
                               show.median = F,
                               show.CI = F)
  UseMethod("Plot.FV.Parameters", dsList)
#' Plot the aggregated empirical cumulative distriburtion as a function of the running times of
#' a DataSetList. Aggregated over multiple functions or dimensions.
#'
#' @param dsList A DataSetList.
#' @param targets The target function values. Specified in a data.frame, as can be generated
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' by the function 'get_ECDF_targets'
#'
#' @return A plot of the empirical cumulative distriburtion as a function of
#' the running times of the DataSetList
#' @export
#' @examples
#' \dontshow{data.table::setDTthreads(1)}
#' Plot.RT.ECDF_Multi_Func(dsl)
Plot.RT.ECDF_Multi_Func <-
  function(dsList,
           targets = NULL,
           scale.xlog = F)
    UseMethod("Plot.RT.ECDF_Multi_Func", dsList)
#' Plot ERT-plots for multiple functions or dimensions
#'
#' @param dsList A DataSetList (should consist of only one function OR dimension).
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param scale.reverse Wheter or not to reverse the x-axis (when using minimization)
#' @param backend Which plotting library to use. Either 'plotly' or 'ggplot2'.
#'
#' @return A plot of ERT-values of the DataSetList
#' @export
#' @examples
#' Plot.RT.Multi_Func(dsl)
Plot.RT.Multi_Func <-
  function(dsList,
           scale.xlog = F,
           scale.ylog = F,
           scale.reverse = F,
           backend = NULL)
    UseMethod("Plot.RT.Multi_Func", dsList)
#' Plot ERT-based comparison over multiple functions or dimensions
#'
#' @param dsList A DataSetList (should consist of only one function OR dimension).
#' @param plot_mode How the plots should be created. Can be 'line' or 'radar'
#' @param aggr_on Whether to compare on functions ('funcId') or dimensions ('DIM')
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param maximize Wheter or not to the data is of a maximization problem
#' @param targets Custom list of function-value targets, one for each function or dimension.
#' @param use_rank Wheter to use a ranking system. If False, the actual ERT-values will be used.
#' @param erts Pre-calculated ERT-values for the provided targets. Created by the max_ERTs function
#' of DataSetList. Can be provided to prevent needless computation in recalculating ERTs when recreating
#' this plot.
#' @param inf.action How to handle infinite ERTs ('overlap' or 'jitter')
#' @return A plot of ERT-based comparison on the provided functions or dimensions of the DataSetList
#' @export
#' @examples
#' Plot.RT.Aggregated(dsl)
Plot.RT.Aggregated <-
  function(dsList,
           aggr_on = 'funcId',
           targets = NULL,
           plot_mode = 'radar',
           use_rank = F,
           scale.ylog = T,
           maximize = T,
           erts = NULL,
           inf.action = 'overlap')
    UseMethod("Plot.RT.Aggregated", dsList)
#' Plot expected function value-based comparison over multiple functions or dimensions
#'
#' @param dsList A DataSetList (should consist of only one function OR dimension).
#' @param plot_mode How the plots should be created. Can be 'line' or 'radar'
#' @param aggr_on Whether to compare on functions ('funcId') or dimensions ('DIM')
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param runtimes Custom list of function-value targets, one for each function or dimension.
#' @param use_rank Wheter to use a ranking system. If False, the actual expected function-
#' values will be used.
#' @param fvs Pre-calculated expected function-values for the provided runtimes Created by the
#' max_ERTs function of DataSetList. Can be provided to prevent needless computation
#' in recalculating ERTs when recreating this plot.
#'
#' @return A plot of expected function value-based comparison on the provided functions
#'  or dimensions of the DataSetList
#' @export
#' @examples
#' Plot.FV.Aggregated(dsl)
Plot.FV.Aggregated <-
  function(dsList,
           aggr_on = 'funcId',
           runtimes = NULL,
           plot_mode = 'radar',
           use_rank = F,
           scale.ylog = T,
           fvs = NULL)
    UseMethod("Plot.FV.Aggregated", dsList)

#' Plot FV-plots for multiple functions or dimensions
#'
#' @param dsList A DataSetList (should consist of only one function OR dimension).
#' @param scale.xlog Whether or not to scale the x-axis logaritmically
#' @param scale.ylog Whether or not to scale the y-axis logaritmically
#' @param backend Which plotting library to use. Either 'plotly' or 'ggplot2'.
#'
#' @return A plot of Function-values of the DataSetList
#' @export
#' @examples
#' Plot.FV.Multi_Func(dsl)
Plot.FV.Multi_Func <-
  function(dsList,
           scale.xlog = F,
           scale.ylog = F,
           backend = NULL)
    UseMethod("Plot.FV.Multi_Func", dsList)

#' Plot a heatmap showing the statistically different algorithms
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param ftarget The target function value to use
#' @param alpha The cutoff for statistical significance
#' @param bootstrap.size The amound of bootstrapped samples used
#' @param which Whether to use fixed-target ('by_FV') or fixed-budget ('by_RT') perspective
#'
#' @return A heatmap showing the statistical significance between algorithms
#' @export
#' @examples
#' Plot.Stats.Significance_Heatmap(subset(dsl, funcId == 2), 16)
Plot.Stats.Significance_Heatmap <-
  function(dsList,
           ftarget,
           alpha = 0.01,
           bootstrap.size = 30,
           which = 'by_FV')
    UseMethod("Plot.Stats.Significance_Heatmap", dsList)

#' Plot a heatmap according to the specifications from the Nevergrad dashboard
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param target_dt A data-table containing the targets to condider on each function/dimension pair
#' @param which Whether to use fixed-target ('by_FV') or fixed-budget ('by_RT') perspective
#'
#' @return A heatmap showing the fraction of times algorithm A beats algorithm B
#' @export
#' @examples
#' Plot.Comparison.Heatmap(dsl)
Plot.Comparison.Heatmap <-
  function(dsList, target_dt, which = 'by_FV')
    UseMethod("Plot.Comparison.Heatmap", dsList)

#' Plot a network graph showing the statistically different algorithms
#'
#' @param dsList A DataSetList (should consist of only one function and dimension).
#' @param ftarget The target function value to use
#' @param alpha The cutoff for statistical significance
#' @param bootstrap.size The amound of bootstrapped samples used
#' @param which Whether to use fixed-target ('by_FV') or fixed-budget ('by_RT') perspective
#'
#' @return A graph showing the statistical significance between algorithms
#' @export
#' @examples
#' Plot.Stats.Significance_Graph(subset(dsl, funcId == 2), 16)
Plot.Stats.Significance_Graph <-
  function(dsList,
           ftarget,
           alpha = 0.01,
           bootstrap.size = 30,
           which = 'by_FV')
    UseMethod("Plot.Stats.Significance_Graph", dsList)

#' Create a candlestick plot of Glicko2-rankings
#'
#' @param dsList A DataSetList
#' @param nr_rounds The number of rounds in the tournament
#' @param glicko2_rank_df Optional. Dataframe containing the glicko2 rating to avoid needless recalculation.
#' @param which Whether to use fixed-target ('by_FV') or fixed-budget ('by_RT') perspective
#' @param target_dt Optional: data table containing the targets for each function and dimension
#'
#' @export
#' @examples
#' Plot.Stats.Glicko2_Candlestick(dsl, nr_rounds=2)
Plot.Stats.Glicko2_Candlestick <-
  function(dsList,
           nr_rounds = 100,
           glicko2_rank_df = NULL,
           which = 'by_FV',
           target_dt = NULL)
    UseMethod("Plot.Stats.Glicko2_Candlestick", dsList)


##Implementations

#' @rdname Plot.RT.Single_Func
#' @export
Plot.RT.Single_Func.DataSetList <-
  function(dsList,
           Fstart = NULL,
           Fstop = NULL,
           show.ERT = T,
           show.CI = T,
           show.mean = F,
           show.median = F,
           backend = NULL,
           scale.xlog = F,
           scale.ylog = F,
           scale.reverse = F,
           includeOpts = F,
           p = NULL) {
    if (is.null(backend))
      backend <-
        getOption("IOHanalyzer.backend", default = 'plotly')

    if (backend == 'plotly') {
      data <-
        generate_data.Single_Function(dsList, Fstart, Fstop, scale.xlog, 'by_RT', includeOpts)

      y_attrs <- c()
      if (show.ERT)
        y_attrs <- c(y_attrs, 'ERT')
      if (show.mean)
        y_attrs <- c(y_attrs, 'mean')
      if (show.median)
        y_attrs <- c(y_attrs, 'median')
      show_legend <- T
      if (length(y_attrs) > 0) {
        p <- plot_general_data(
          data,
          x_attr = 'target',
          y_attr = y_attrs,
          type = 'line',
          legend_attr = 'ID',
          show.legend = show_legend,
          scale.ylog = scale.ylog,
          p = p,
          scale.xlog = scale.xlog,
          x_title = "Best-so-far f(x)-value",
          y_title = "Function Evaluations",
          scale.reverse = scale.reverse
        )
        show_legend <- F
      }
      if (show.CI) {
        p <- plot_general_data(
          data,
          x_attr = 'target',
          y_attr = 'mean',
          type = 'ribbon',
          legend_attr = 'ID',
          lower_attr = 'lower',
          upper_attr = 'upper',
          p = p,
          show.legend = show_legend,
          scale.ylog = scale.ylog,
          scale.xlog = scale.xlog,
          x_title = "Best-so-far f(x)-value",
          y_title = "Function Evaluations",
          scale.reverse = scale.reverse
        )
      }
    }
    # } else if (backend == 'ggplot2') {
    #   dt[, 'group' := paste(algId, funcId, DIM, sep = '-')]
    #   p <- ggplot(data = dt, aes(group = `group`, colour = `group`))
    #
    #   if (show.CI) p <- p + geom_ribbon(aes(target, ymin = lower, ymax = upper, fill = `group`),
    #                                     alpha = 0.2, colour = NA)
    #   if (show.ERT) p <- p + geom_line(aes(target, ERT), size = 1.2)
    #   if (show.mean) p <- p + geom_line(aes(target, mean), linetype = 'dashed')
    #   if (show.median) p <- p + geom_line(aes(target, median), linetype = 'dotted')
    #
    #   p <- p +
    #     scale_color_manual(values = colors) +
    #     scale_fill_manual(values = colors)
    # }
    return(p)
  }

#' @rdname Plot.FV.Single_Func
#' @export
Plot.FV.Single_Func.DataSetList <-
  function(dsList,
           RTstart = NULL,
           RTstop = NULL,
           show.CI = F,
           show.mean = T,
           show.median = F,
           backend = NULL,
           scale.xlog = F,
           scale.ylog = F,
           scale.reverse = F) {
    if (is.null(backend))
      backend <-
        getOption("IOHanalyzer.backend", default = 'plotly')

    if (backend == 'plotly') {
      data <-
        generate_data.Single_Function(dsList, RTstart, RTstop, scale.xlog, 'by_FV')

      y_attrs <- c()
      if (show.mean)
        y_attrs <- c(y_attrs, 'mean')
      if (show.median)
        y_attrs <- c(y_attrs, 'median')
      show_legend <- T
      if (length(y_attrs) > 0) {
        p <- plot_general_data(
          data,
          x_attr = 'runtime',
          y_attr = y_attrs,
          type = 'line',
          legend_attr = 'ID',
          show.legend = show_legend,
          scale.ylog = scale.ylog,
          scale.xlog = scale.xlog,
          x_title = "Best-so-far f(x)-value",
          y_title = "Function Evaluations",
          scale.reverse = scale.reverse
        )
        show_legend <- F
      }
      else
        p <- NULL
      if (show.CI) {
        p <- plot_general_data(
          data,
          x_attr = 'runtime',
          y_attr = 'mean',
          type = 'ribbon',
          legend_attr = 'ID',
          lower_attr = 'lower',
          upper_attr = 'upper',
          p = p,
          show.legend = show_legend,
          scale.ylog = scale.ylog,
          scale.xlog = scale.xlog,
          x_title = "Best-so-far f(x)-value",
          y_title = "Function Evaluations",
          scale.reverse = scale.reverse
        )
      }

    }
    # } else if (backend == 'ggplot2') {
    #   fce[, 'group' := paste(algId, funcId, DIM, sep = '-')]
    #   p <- ggplot(data = fce, aes(group = `group`, colour = `group`))
    #
    #   if (show.mean) p <- p + geom_line(aes(runtime, mean), linetype = 'dashed')
    #   if (show.median) p <- p + geom_line(aes(runtime, median), linetype = 'dotted')
    #
    #   p <- p +
    #     scale_color_manual(values = colors) +
    #     scale_fill_manual(values = colors)
    #
    #   #TODO: add individual run etc
    # }
    return(p)
  }

#' @rdname Plot.RT.PMF
#' @export
Plot.RT.PMF.DataSetList <-
  function(dsList,
           ftarget,
           show.sample = F,
           scale.ylog = F,
           backend = NULL) {
    if (is.null(backend))
      backend <-
        getOption("IOHanalyzer.backend", default = 'plotly')

    data <- generate_data.PMF(dsList, ftarget, 'by_RT')

    plot_general_data(
      data,
      'ID',
      'RT',
      scale.ylog = scale.ylog,
      x_title = "Algorithm",
      y_title = "Function Evaluations"
    )
  }

#' @rdname Plot.RT.Histogram
#' @export
Plot.RT.Histogram.DataSetList <-
  function(dsList,
           ftarget,
           plot_mode = 'overlay',
           use.equal.bins = F) {
    if (length(get_funcId(dsList)) != 1 ||
        length(get_dim(dsList)) != 1) {
      warning(
        "Invalid dataset uploaded. Please ensure the datasetlist contains data
            from only one function and only one dimension."
      )
      return(NULL)
    }
    data <-
      generate_data.hist(dsList, ftarget, use.equal.bins, 'by_RT')

    subplot_attr <- if (plot_mode == 'subplot')
      'ID'
    else
      NULL
    plot_general_data(
      data,
      'x',
      'y',
      width = 'width',
      type = 'hist',
      subplot_attr = subplot_attr,
      x_title = "Function Evaluations",
      y_title = "Runs"
    )
  }

#' @rdname Plot.RT.ECDF_Per_Target
#' @export
Plot.RT.ECDF_Per_Target.DataSetList <-
  function(dsList, ftargets, scale.xlog = F) {
    req(length(ftargets) != 0)
    data <- generate_data.ECDF(dsList, ftargets, scale.xlog)
    plot_general_data(
      data,
      'x',
      'mean',
      'line',
      x_title = "Function Evaluations",
      y_title = "Proportion of runs",
      scale.xlog = scale.xlog,
      show.legend = T
    )
  }

#' @rdname Plot.RT.ECDF_Single_Func
#' @export
Plot.RT.ECDF_Single_Func.DataSetList <-
  function(dsList,
           fstart = NULL,
           fstop = NULL,
           fstep = NULL,
           show.per_target = F,
           scale.xlog = F) {
    targets <- seq_FV(get_funvals(dsList), fstart, fstop, fstep)
    req(targets)

    data <- generate_data.ECDF(dsList, targets, scale.xlog)

    plot_general_data(
      data,
      'x',
      'mean',
      'line',
      x_title = "Function Evaluations",
      y_title = "Proportion of (run, target) pairs",
      scale.xlog = scale.xlog,
      show.legend = T
    )
  }

#' @rdname Plot.RT.ECDF_AUC
#' @export
Plot.RT.ECDF_AUC.DataSetList <- function(dsList,
                                         fstart = NULL,
                                         fstop = NULL,
                                         fstep = NULL,
                                         fval_formatter = as.integer) {
  targets <-
    seq_FV(get_funvals(dsList), fstart, fstop, fstep, length.out = 10)
  req(targets)

  data <- generate_data.AUC(dsList, targets, multiple_x = TRUE)

  plot_general_data(data, 'x', 'auc', 'radar')
}

#' @rdname Plot.FV.PDF
#' @export
Plot.FV.PDF.DataSetList <-
  function(dsList,
           runtime,
           show.sample = F,
           scale.ylog = F) {
    data <- generate_data.PMF(dsList, runtime, 'by_FV')

    plot_general_data(
      data,
      'ID',
      'f(x)',
      scale.ylog = scale.ylog,
      x_title = "Algorithm",
      y_title = "Target Value"
    )
  }

#' @rdname Plot.FV.Histogram
#' @export
Plot.FV.Histogram.DataSetList <-
  function(dsList,
           runtime,
           plot_mode = 'overlay',
           use.equal.bins = F) {
    if (length(get_funcId(dsList)) != 1 ||
        length(get_dim(dsList)) != 1) {
      warning(
        "Invalid dataset uploaded. Please ensure the datasetlist contains data
            from only one function and only one dimension."
      )
      return(NULL)
    }
    data <-
      generate_data.hist(dsList, runtime, use.equal.bins, 'by_FV')

    subplot_attr <- if (plot_mode == 'subplot')
      'ID'
    else
      NULL
    plot_general_data(
      data,
      'x',
      'y',
      width = 'width',
      type = 'hist',
      subplot_attr = subplot_attr,
      x_title = "Target Values",
      y_title = "Runs"
    )
  }

#' @rdname Plot.FV.ECDF_Per_Target
#' @export
Plot.FV.ECDF_Per_Target.DataSetList <-
  function(dsList,
           runtimes,
           scale.xlog = F,
           scale.reverse = F) {
    #TODO: Fvals in legend need to be formatted properly
    runtimes <- runtimes[!is.na(runtimes)]
    req(length(runtimes) != 0)

    data <-
      generate_data.ECDF(dsList, runtimes, scale.xlog, which = 'by_FV')

    plot_general_data(
      data,
      'x',
      'mean',
      'line',
      x_title = "Target Value",
      y_title = "Proportion of runs",
      scale.xlog = scale.xlog,
      show.legend = T,
      scale.reverse = scale.reverse
    )
  }

#' @rdname Plot.FV.ECDF_Single_Func
#' @export
Plot.FV.ECDF_Single_Func.DataSetList <-
  function(dsList,
           rt_min = NULL,
           rt_max = NULL,
           rt_step = NULL,
           scale.xlog = F,
           show.per_target = F,
           scale.reverse = F) {
    targets <- seq_RT(get_funvals(dsList), rt_min, rt_max, rt_step)
    req(targets)
    data <-
      generate_data.ECDF(dsList, targets, scale.xlog, which = 'by_FV')

    plot_general_data(
      data,
      'x',
      'mean',
      'line',
      x_title = "Target Value",
      y_title = "Proportion of (run, target) pairs",
      scale.xlog = scale.xlog,
      scale.reverse = scale.reverse,
      show.legend = T
    )
  }

#' @rdname Plot.FV.ECDF_AUC
#' @export
Plot.FV.ECDF_AUC.DataSetList <-
  function(dsList,
           rt_min = NULL,
           rt_max = NULL,
           rt_step = NULL) {
    targets <-
      seq_RT(get_runtimes(dsList), rt_min, rt_max, rt_step, length.out = 10)
    req(targets)
    data <-
      generate_data.AUC(dsList, targets, which = 'by_FV', multiple_x = TRUE)

    plot_general_data(data, 'x', 'auc', 'radar')
  }

#' @rdname Plot.RT.Parameters
#' @export
Plot.RT.Parameters.DataSetList <-
  function(dsList,
           f_min = NULL,
           f_max = NULL,
           algids = 'all',
           par_name = NULL,
           scale.xlog = F,
           scale.ylog = F,
           show.mean = T,
           show.median = F,
           show.CI = F) {
    data <-
      generate_data.Parameters(dsList, scale.xlog, which = 'by_FV')

    y_attrs <- c()
    if (show.mean)
      y_attrs <- c(y_attrs, 'mean')
    if (show.median)
      y_attrs <- c(y_attrs, 'median')
    show_legend <- T
    if (length(y_attrs) > 0) {
      p <- plot_general_data(
        data,
        x_attr = 'target',
        y_attr = y_attrs,
        type = 'line',
        legend_attr = 'ID',
        show.legend = show_legend,
        scale.ylog = scale.ylog,
        subplot_attr = 'parId',
        scale.xlog = scale.xlog
      )
      show_legend <- F
    }
    else
      p <- NULL
    if (show.CI) {
      p <- plot_general_data(
        data,
        x_attr = 'target',
        y_attr = 'mean',
        type = 'ribbon',
        legend_attr = 'ID',
        lower_attr = 'lower',
        upper_attr = 'upper',
        p = p,
        show.legend = show_legend,
        scale.ylog = scale.ylog,
        subplot_attr = 'parId',
        scale.xlog = scale.xlog
      )
    }
    p
  }


#' @rdname Plot.FV.Parameters
#' @export
Plot.FV.Parameters.DataSetList <-
  function(dsList,
           rt_min = NULL,
           rt_max = NULL,
           algids = 'all',
           par_name = NULL,
           scale.xlog = F,
           scale.ylog = F,
           show.mean = T,
           show.median = F,
           show.CI = F) {
    data <-
      generate_data.Parameters(dsList, scale.xlog, which = 'by_RT')

    y_attrs <- c()
    if (show.mean)
      y_attrs <- c(y_attrs, 'mean')
    if (show.median)
      y_attrs <- c(y_attrs, 'median')
    show_legend <- T
    if (length(y_attrs) > 0) {
      p <- plot_general_data(
        data,
        x_attr = 'runtime',
        y_attr = y_attrs,
        type = 'line',
        legend_attr = 'ID',
        show.legend = show_legend,
        scale.ylog = scale.ylog,
        subplot_attr = 'parId',
        scale.xlog = scale.xlog
      )
      show_legend <- F
    }
    else
      p <- NULL
    if (show.CI) {
      p <- plot_general_data(
        data,
        x_attr = 'runtime',
        y_attr = 'mean',
        type = 'ribbon',
        legend_attr = 'ID',
        lower_attr = 'lower',
        upper_attr = 'upper',
        p = p,
        show.legend = show_legend,
        scale.ylog = scale.ylog,
        subplot_attr = 'parId',
        scale.xlog = scale.xlog
      )
    }
    p
  }

#' @rdname Plot.RT.ECDF_Multi_Func
#' @export
Plot.RT.ECDF_Multi_Func.DataSetList <-
  function(dsList,
           targets = NULL,
           scale.xlog = F) {
    if (is.null(targets) || !is.data.table(targets)) {
      targets <- get_ECDF_targets(dsList)
    }

    data <- generate_data.ECDF(dsList, targets, scale.xlog)

    plot_general_data(
      data,
      'x',
      'mean',
      'line',
      scale.xlog = scale.xlog,
      x_title = "Function Evaluations",
      y_title = "Proportion of (run, target, ...) pairs",
      show.legend = T
    )
  }

#' @rdname Plot.RT.Multi_Func
#' @export
Plot.RT.Multi_Func.DataSetList <- function(dsList,
                                           scale.xlog = F,
                                           scale.ylog = F,
                                           scale.reverse = F,
                                           backend = NULL) {
  if (is.null(backend))
    backend <- getOption("IOHanalyzer.backend", default = 'plotly')

  data <- rbindlist(lapply(get_funcId(dsList), function(fid) {
    generate_data.Single_Function(subset(dsList, funcId == fid),
                                  scale_log = scale.xlog,
                                  which = 'by_RT')
  }))

  plot_general_data(
    data,
    x_attr = 'target',
    y_attr = 'ERT',
    subplot_attr = 'funcId',
    type = 'line',
    scale.xlog = scale.xlog,
    scale.ylog = scale.ylog,
    x_title = 'Best-so-far f(x)',
    y_title = 'ERT',
    show.legend = T,
    scale.reverse = scale.reverse
  )
}

#' @rdname Plot.FV.Multi_Func
#' @export
Plot.FV.Multi_Func.DataSetList <- function(dsList,
                                           scale.xlog = F,
                                           scale.ylog = F,
                                           backend = NULL) {
  if (is.null(backend))
    backend <- getOption("IOHanalyzer.backend", default = 'plotly')

  data <- rbindlist(lapply(get_funcId(dsList), function(fid) {
    generate_data.Single_Function(subset(dsList, funcId == fid),
                                  scale_log = scale.xlog,
                                  which = 'by_FV')
  }))

  plot_general_data(
    data,
    x_attr = 'runtime',
    y_attr = 'mean',
    subplot_attr = 'funcId',
    type = 'line',
    scale.xlog = scale.xlog,
    scale.ylog = scale.ylog,
    x_title = 'Runtime',
    y_title = 'Best-so-far f(x)',
    show.legend = T
  )
}

#' @rdname Plot.RT.Aggregated
#' @export
Plot.RT.Aggregated.DataSetList <-
  function(dsList,
           aggr_on = 'funcId',
           targets = NULL,
           plot_mode = 'radar',
           use_rank = F,
           scale.ylog = T,
           maximize = T,
           erts = NULL,
           inf.action = 'overlap') {
    targets <- get_target_dt(dsList)
    data <-
      generate_data.Aggr(dsList, aggr_on = aggr_on, targets = targets)
    y_attr <- if (use_rank)
      'rank'
    else
      'value'
    y_title <- if (use_rank)
      'Rank'
    else
      'ERT'
    plot_general_data(
      data,
      type = plot_mode,
      x_attr = 'funcId',
      y_attr = y_attr,
      x_title = "FuncId",
      y_title = y_title,
      show.legend = T,
      scale.ylog = scale.ylog,
      inf.action = inf.action
    )
  }

#' @rdname Plot.FV.Aggregated
#' @export
Plot.FV.Aggregated.DataSetList <-
  function(dsList,
           aggr_on = 'funcId',
           runtimes = NULL,
           plot_mode = 'radar',
           use_rank = F,
           scale.ylog = T,
           fvs = NULL) {
    targets <- get_target_dt(dsList, which = 'by_FV')
    data <-
      generate_data.Aggr(dsList,
                         aggr_on = aggr_on,
                         targets = targets,
                         which = 'by_FV')
    y_attr <- if (use_rank)
      'rank'
    else
      'value'
    y_title <- if (use_rank)
      'Rank'
    else
      'Best-so-far f(x)'
    plot_general_data(
      data,
      type = plot_mode,
      x_attr = 'funcId',
      y_attr = y_attr,
      x_title = "FuncId",
      y_title = y_title,
      show.legend = T,
      scale.ylog = scale.ylog
    )
  }

#' @rdname Plot.Stats.Significance_Heatmap
#' @export
Plot.Stats.Significance_Heatmap.DataSetList <-
  function(dsList,
           ftarget,
           alpha = 0.01,
           bootstrap.size = 30,
           which = 'by_FV') {
    if (length(get_dim(dsList)) != 1 ||
        length(get_funcId(dsList)) != 1 ||
        length(get_id(dsList)) < 2)
      return(NULL)

    p_matrix <-
      pairwise.test(dsList, ftarget, bootstrap.size, which)
    y <- p_matrix <= alpha
    colorScale <- data.frame(
      x = c(-1, -0.33, -0.33, 0.33, 0.33, 1),
      col = c('blue', 'blue', 'white', 'white', 'red', 'red')
    )
    heatmap <-  y - t(y)
    heatmap[is.na(heatmap)] <- 0
    p <-
      plot_ly(
        x = colnames(y),
        y = rownames(y),
        z = heatmap,
        type = 'heatmap',
        xgap = 0.2,
        ygap = 0.2,
        colorscale = colorScale,
        showscale = F
      )
    p %<>% layout(
      yaxis = list(autorange = 'reversed', scaleratio = 1),
      xaxis = list(tickangle = 45)
    )
    p
  }

#' @rdname Plot.Comparison.Heatmap
#' @export
Plot.Comparison.Heatmap.DataSetList <-
  function(dsList,
           target_dt = NULL,
           which = 'by_FV') {
    matr <- generate_data.Heatmaps(dsList, which, target_dt)
    order <- rowMeans(matr) %>% sort(decreasing = T) %>% names
    matr <- matr[order[1:min(6, length(order))], order]
    p <-
      plot_ly(
        x = colnames(matr),
        y = rownames(matr),
        z = matr,
        type = 'heatmap',
        xgap = 0.2,
        ygap = 0.2,
        colorscale = 'RdBu',
        showscale = F,
        zmin = 0,
        zmax = 1
      )
    p %<>% layout(
      yaxis = list(autorange = 'reversed', scaleratio = 1),
      xaxis = list(tickangle = 45)
    )
    p
  }

#' Helper function for Plot.Stats.Significance_Graph
#'
#' @param x x
#' @param start default is 0
#' @param direction default is 1
#'
#' @noRd
radian.rescale <- function(x,
                           start = 0,
                           direction = 1) {
  c.rotate <- function(x)
    (x + start) %% (2 * pi) * direction
  c.rotate((2 * pi * (x - min(x)) / (max(x) - min(x))))
}

#' @rdname Plot.Stats.Significance_Graph
#' @export
Plot.Stats.Significance_Graph.DataSetList <-
  function(dsList,
           ftarget,
           alpha = 0.01,
           bootstrap.size = 30,
           which = 'by_FV') {
    if (!requireNamespace("igraph", quietly = TRUE)) {
      stop("Package \"igraph\" needed for this function to work. Please install it.",
           call. = FALSE)
    }
    if (length(get_dim(dsList)) != 1 ||
        length(get_funcId(dsList)) != 1 ||
        length(get_id(dsList)) < 2) {
      return(NULL)
    }
    p_matrix <-
      pairwise.test(dsList, ftarget, bootstrap.size, which)
    g <-
      igraph::graph_from_adjacency_matrix(p_matrix <= alpha, mode = 'directed', diag = F)
    lab.locs <-
      radian.rescale(x = 1:nrow(p_matrix),
                     direction = -1,
                     start = 0)

    igraph::plot.igraph(
      g,
      layout = igraph::layout.circle(g),
      vertex.size = 10,
      edge.arrow.size = 1,
      vertex.label.color = 'black',
      vertex.label.dist = 2,
      vertex.label.cex = 1,
      vertex.label.degree = lab.locs
    )
  }

#' @rdname Plot.Stats.Glicko2_Candlestick
#' @export
Plot.Stats.Glicko2_Candlestick.DataSetList <-
  function(dsList,
           nr_rounds = 100,
           glicko2_rank_df = NULL,
           which = 'by_FV',
           target_dt = NULL) {
    df <- glicko2_rank_df

    if (is.null(df)) {
      df <-
        glicko2_ranking(dsList, nr_rounds, which, target_dt = target_dt)$ratings
      Ids <- df$Player$ID
    }
    else{
      Ids <- df$ID
    }
    p <- IOH_plot_ly_default(title = "Glicko2-rating",
                             x.title = "ID",
                             y.title = "Rating")
    df$Rating %<>% as.numeric
    df$Deviation %<>% as.numeric
    high <- df$Rating + 3 * df$Deviation
    low <- df$Rating - 3 * df$Deviation
    open <- df$Rating + df$Deviation
    close <- df$Rating - df$Deviation

    N <- length(df$Rating)
    colors <- get_color_scheme(Ids)
    if (length(colors != N)) {
      colors <- get_color_scheme(get_id(dsList))
    }

    for (i in seq(N)) {
      # rgba_str <- paste0('rgba(', paste0(col2rgb(colors[i]), collapse = ','), ',0.52)')
      color <- list(line = list(color = colors[[i]]))
      p %<>% add_trace(
        type = "candlestick",
        x = Ids[[i]],
        open = open[[i]],
        close = close[[i]],
        high = high[[i]],
        low = low[[i]],
        legendgroup = Ids[[i]],
        name = Ids[[i]],
        increasing = color,
        decreasing = color,
        hovertext = paste0(
          format(df$Rating[[i]], digits = 3),
          '+-',
          format(df$Deviation[[i]], digits = 3)
        ),
        hoverinfo = "text"
      )
    }
    p %<>% layout(xaxis = list(rangeslider = list(visible = F)))
    p
  }

### _______________________ Rewritten plotting function ____________________ ###

#' Add transparancy to named list of colors
#'
#' @param colors Named list of colors (in hex-notation)
#' @param percentage The percentage of opacity. 0 is fully transparant, 1 is fully opaque
#'
#' @noRd
add_transparancy <- function(colors, percentage) {
  hex_val <-
    format(as.hexmode(as.integer(255 * percentage)),
           upper.case = T,
           width = 2)
  sapply(colors, function(col) {
    col <- paste0('#',  substr(col, 2, 7), hex_val)
  })
}

#' General function for plotting within IOHanalyzer
#'
#' @param df The dataframe containing the data to plot. It should contain at least two columns:
#' 'x_attr' and 'y_attr'
#' @param x_attr The column to specify the x_axis. Default is 'algId'
#' @param legend_attr Default is 'algId' This is also used for the selection of colorschemes
#' @param y_attr The column to specify the y_axis
#' @param type The type of plot to use. Currently available: 'violin', 'line', 'radar',
#' 'bar', hist' and 'ribbon'
#' @param upper_attr When using ribbon-plot, this can be used to create a shaded area.
#' Only works in combination with`lower_attr` and `type` == 'ribbon'
#' @param lower_attr When using ribbon-plot, this can be used to create a shaded area.
#' Only works in combination with`upper_attr` and `type` == 'ribbon'
#' @param subplot_attr Which attribute of the dataframe to use for creating subplots
#' @param subplot_shareX Whether or not to share X-axis when using subplots
#' @param scale.xlog Logarithmic scaling of x-axis
#' @param scale.ylog Logarithmic scaling of y-axis
#' @param scale.reverse Decreasing or increasing x-axis
#' @param x_title Title of x-axis. Defaults to x_attr
#' @param y_title Title of x-axis. Defaults to x_attr
#' @param plot_title Title of x-axis. Defaults to no title
#' @param p A previously existing plot on which to add traces. If NULL, a new canvas is created
#' @param show.legend Whether or not to include a legend
#' @param inf.action How to deal with infinite values. Can be 'none', 'overlap' or 'jitter'
#' @param violin.showpoints Wheteher or not to show individual points when making a violinplot
#' @param frame_attr Which attribute of the dataframe to use for the time element of the animation
#' @param symbol_attr Which attribute of the dataframe to use for the scatter symbol
#' @param line.step Whether to plot lines as a step-function (T) or as linear interpolation (F, default)
#' @param ... Additional parameters for the add_trace function
#'
#'
#' @export
plot_general_data <-
  function(df,
           x_attr = 'ID',
           y_attr = 'vals',
           type = 'violin',
           legend_attr = 'ID',
           scale.xlog = F,
           scale.ylog = F,
           scale.reverse = F,
           p = NULL,
           x_title = NULL,
           y_title = NULL,
           plot_title = NULL,
           upper_attr = NULL,
           lower_attr = NULL,
           subplot_attr = NULL,
           show.legend = F,
           inf.action = 'none',
           violin.showpoints = F,
           frame_attr = 'frame',
           symbol_attr = 'run_nr',
           subplot_shareX = F,
           line.step = F,
           ...) {
    l <-
      x <-
      isinf <-
      y <-
      text <-
      l_orig <- frame <- NULL #Set local binding to remove warnings

    #Only allow valid plot types
    if (!(
      type %in% c(
        'violin',
        'line',
        'radar',
        'hist',
        'ribbon',
        'line+ribbon',
        'bar',
        'anim-scatter',
        'scatter'
      )
    )) {
      stop(paste0("Provided plot type ('", type, "') is not supported"))
    }

    #And valid number of y-attributes
    if (length(y_attr) == 0) {
      stop("At least one y-attribute is needed to plot")
    }

    #Deal with subplots
    if (!is.null(subplot_attr)) {
      if (!subplot_attr %in% colnames(df)) {
        stop("Provided subplot-attribut is not a colname of the selected data.table.")
      }
      colnames(df)[colnames(df) == subplot_attr] <- "subplot_attr"
      attrs <- unique(df[, subplot_attr])
      if (length(attrs) == 0)
        stop(
          "Attempting to create subplots with fewer than 2 unique values of
                                 `subplot_attrs`-column"
        )
      if (length(attrs) == 1)
        return(
          plot_general_data(
            df,
            x_attr,
            y_attr,
            type,
            legend_attr,
            scale.xlog,
            scale.ylog,
            scale.reverse,
            p,
            x_title,
            y_title,
            attrs,
            upper_attr,
            lower_attr,
            show.legend = show.legend,
            subplot_attr = NULL,
            ...
          )
        )
      if (subplot_attr == legend_attr) {
        df[, l := subplot_attr]
      }

      #Only need one legend for the whole plot
      legends_show <- rep(F, length(attrs))
      legends_show[[1]] <- show.legend
      names(legends_show) <- as.character(attrs)

      #Get some number of rows and columns
      n_cols <- 1 + ceiling(length(attrs) / 10)
      n_rows <- ceiling(length(attrs) / n_cols)

      p <- lapply(seq(length(attrs)), function(idx) {
        attr_val <- attrs[[idx]]
        df_sub <- df[subplot_attr == attr_val]
        disp_y <-  idx %% n_cols == 1
        disp_x <- idx > (length(attrs) - n_cols)
        x.title = if (disp_x)
          x_title
        else
          ""
        y.title = if (disp_y)
          y_title
        else
          ""

        #Generate title for the subplots
        if (stri_detect_regex(subplot_attr, "(?i)fun"))
          sub_title <- paste0('F', attr_val)
        else if (stri_detect_regex(subplot_attr, "(?i)dim"))
          sub_title <- paste0('D', attr_val)
        else
          sub_title <- paste0(attr_val)
        p <- NULL
        if (stri_detect_fixed(type, '+')) {
          type1 <-
            substr(type, 0, stri_locate_all(type, fixed = '+')[[1]][[1]] - 1)
          p <-
            plot_general_data(
              df_sub,
              x_attr,
              y_attr,
              type1,
              legend_attr,
              scale.xlog,
              scale.ylog,
              scale.reverse,
              NULL,
              x.title,
              y.title,
              plot_title,
              upper_attr,
              lower_attr,
              show.legend = legends_show[[as.character(attr_val)]],
              subplot_attr = NULL,
              ...
            )
          type <-
            substr(type,
                   stri_locate_all(type, fixed = '+')[[1]][[1]] + 1,
                   nchar(type))
        }
        p <-
          plot_general_data(
            df_sub,
            x_attr,
            y_attr,
            type,
            legend_attr,
            scale.xlog,
            scale.ylog,
            scale.reverse,
            p,
            x.title,
            y.title,
            plot_title,
            upper_attr,
            lower_attr,
            show.legend = legends_show[[as.character(attr_val)]],
            subplot_attr = NULL,
            ...
          )
        if (getOption("IOHanalyzer.annotation_x", 0.5) >= 0 &
            getOption("IOHanalyzer.annotation_y", 1) >= 0) {
          p %<>% layout(
            annotations = list(
              text = sub_title,
              font = f2,
              showarrow = FALSE,
              xref = "paper",
              yref = "paper",
              x = getOption("IOHanalyzer.annotation_x", 0.5),
              y = getOption("IOHanalyzer.annotation_y", 1)
            )
          )
          p
        }

      })

      p <- subplot(
        p,
        nrows = n_rows,
        titleX = T,
        titleY = T,
        margin = c(
          getOption("IOHanalyzer.margin_horizontal", 0.02),
          getOption("IOHanalyzer.margin_vertical", 0.02),
          getOption("IOHanalyzer.margin_horizontal", 0.02),
          getOption("IOHanalyzer.margin_vertical", 0.02)
        ),
        shareX = subplot_shareX
      ) %>%
        layout(title = plot_title)
      return(p)
    }

    # Replace colnames to have easier matching
    if (!x_attr %in% colnames(df) ||
        !all(y_attr %in% colnames(df))) {
      stop("Not all provided attributes are colnames of the selected data.table.")
    }
    colnames(df)[colnames(df) == x_attr] <- "x"


    if (length(y_attr) == 1 && type != 'line')
      colnames(df)[colnames(df) == y_attr] <- "y"
    else if (type != 'line')
      stop("Multiple y-attrs is currently only supported for line-plots")

    if (!is.null(upper_attr) && !is.null(lower_attr)) {
      if (!upper_attr %in% colnames(df) ||
          !lower_attr %in% colnames(df)) {
        stop("Provided upper and lower attributes are not colnames of the selected data.table.")
      }
      colnames(df)[colnames(df) == upper_attr] <- "upper"
      colnames(df)[colnames(df) == lower_attr] <- "lower"
    }

    if (x_attr != legend_attr) {
      colnames(df)[colnames(df) == legend_attr] <- "l"
      xs <- unique(df[['l']])
    }
    else{
      xs <- unique(df[['x']])
    }

    #Get color and based on legend-attribute
    colors <- get_color_scheme(xs)
    if (is.null(names(colors)) ||
        !all(names(colors) %in% xs))
      names(colors) <- xs

    xscale <- if (scale.xlog)
      'log'
    else
      'linear'
    yscale <- if (scale.ylog)
      'log'
    else
      'linear'

    #If new plot is needed, create one. Store in bool to decide if axis scaling is needed.
    is_new_plot <- F
    if (is.null(p)) {
      p <-
        IOH_plot_ly_default(
          x.title = ifelse(is.null(x_title), x_attr, x_title),
          y.title = ifelse(is.null(y_title), y_attr, y_title),
          title = plot_title
        )
      is_new_plot <- T
    }

    switch(
      type,
      'violin' = {
        if (legend_attr != x_attr) {
          warning("Inconsistent attribute selected for x-axis and legend. Using x_attr as name")
        }
        #Update names to aviod numerical legend
        if (is.numeric(df[['x']])) {
          if (stri_detect_regex(x_attr, "(?i)fun"))
            df <- df[, x := paste0('F', sprintf("%02d", x))]
          else if (stri_detect_regex(x_attr, "(?i)dim"))
            df <- df[, x := paste0('D', as.character(x))]
          else
            df <- df[, x := as.character(x)]
        }
        #Update color names as well, since the value changed
        names(colors) <- unique(df[['x']])

        p %<>%
          add_trace(
            data = df,
            x = ~ x,
            y = ~ y,
            type = 'violin',
            hoveron = "points+kde",
            points = violin.showpoints,
            pointpos = 1.5,
            jitter = 0,
            scalemode = 'count',
            meanline = list(visible = F),
            name = ~ x,
            colors = colors,
            color = ~ x,
            split = ~ x,
            line = list(color = 'black', width = 1.1),
            box = list(visible = T),
            spanmode = 'hard',
            showlegend = show.legend,
            ...
          )
        if (is_new_plot) {
          p %<>% layout(yaxis = list(
            type = yscale,
            tickfont = f3(),
            ticklen = 3
          ))
        }
      },
      'line' = {
        if (legend_attr == x_attr) {
          stop("Duplicated attribute selected for x-axis and legend.")
        }

        # Force legend to be categorical
        df[, l_orig := l]
        if (is.numeric(df[['l']])) {
          df[, l := paste0('A', l)]
          names(colors) <- paste0('A', names(colors))
        }

        #Use linestyles to differentiate traces if only one attribute is selected to be plotted
        #TODO: Combine these two options more elegantly
        if (length(y_attr) == 1) {
          dashes <- get_line_style(xs)
          names(dashes) <- xs
          colnames(df)[colnames(df) == y_attr] <- "y"

          df[, isinf := is.infinite(y)]
          df[, text := as.character(round(y, getOption("IOHanalyzer.precision", 2)))]

          if (inf.action == 'overlap') {
            maxval <- max(df[isinf == F, 'y'])
            df[['y']][df[['isinf']]] <-
              10 ** (ceiling(log10(maxval)) + 1)
          }
          else if (inf.action == 'jitter') {
            #TODO: Faster way to compute this
            maxval <- max(df[isinf == F, 'y'])
            for (xval in unique(df[['x']])) {
              tempval <- 10 ** (ceiling(log10(maxval)) + 1)
              for (lval in unique(df[['l']])) {
                temp <- df[l == lval][x == xval]
                if (nrow(temp) > 0 &&
                    df[l == lval][x == xval][['isinf']]) {
                  df[l == lval][x == xval][['y']] <- tempval
                  tempval <- 1.2 * tempval
                }
              }
            }
          }

          suppressWarnings(
            p %<>%
              add_trace(
                data = df,
                x = ~ x,
                y = ~ y,
                color = ~ l,
                legendgroup = ~ l_orig,
                name = ~ l_orig,
                type = 'scatter',
                mode = 'lines+markers',
                linetype = ~ l_orig,
                marker = list(size = getOption('IOHanalyzer.markersize', 4)),
                linetypes = dashes,
                colors = colors,
                showlegend = show.legend,
                text = ~ text,
                line = list(
                  width = getOption('IOHanalyzer.linewidth', 2),
                  shape = ifelse(line.step, "hv", "linear")
                ),
                hovertemplate = '%{text}',
                ...
              )
          )
          if (inf.action != 'none') {
            p %<>% add_trace(
              data = df[isinf == T],
              x = ~ x,
              y = ~ y,
              legendgroup = ~ l_orig,
              name = ~ l_orig,
              type = 'scatter',
              mode = 'markers',
              color = ~ l,
              marker = list(
                symbol = 'circle-open',
                size = 8 + getOption('IOHanalyzer.markersize', 4)
              ),
              colors = colors,
              showlegend = F,
              text = 'Inf',
              hoverinfo = 'none',
              ...
            )
          }

        }
        else {
          if (inf.action != 'none') {
            warning("inf.action is not yet supported for multiple y-attributes")
          }

          dashes_full <-
            rep(
              c(
                "solid",
                "dot",
                "dash",
                "longdash",
                "dashdot",
                "longdashdot"
              ),
              ceiling(length(y_attr) / 3)
            )[1:length(y_attr)]
          names(dashes_full) <- y_attr

          for (y_atr in y_attr) {
            colnames(df)[colnames(df) == y_atr] <- "y"

            #TODO: Figure out how to supress warning about 6 linetypes
            dashstyle <- dashes_full[[y_atr]]
            suppressWarnings(
              p %<>%
                add_trace(
                  data = df,
                  x = ~ x,
                  y = ~ y,
                  color = ~ l,
                  legendgroup = ~ l_orig,
                  name = ~ l_orig,
                  type = 'scatter',
                  mode = 'lines+markers',
                  marker = list(size = getOption('IOHanalyzer.markersize', 4)),
                  linetype = dashstyle,
                  colors = colors,
                  showlegend = show.legend,
                  name = ~ l,
                  text = y_atr,
                  line = list(
                    width = getOption('IOHanalyzer.linewidth', 2),
                    shape = ifelse(line.step, "hv", "linear")
                  ),
                  ...
                )
            )
            colnames(df)[colnames(df) == "y"] <- y_atr
            show.legend <- F
          }
        }
        if (is_new_plot) {
          if (is.numeric(df[['x']]))
            p %<>% layout(
              xaxis = list(
                type = xscale,
                tickfont = f3(),
                ticklen = 3,
                autorange = ifelse(scale.reverse, "reversed", T)
              ),
              yaxis = list(
                type = yscale,
                tickfont = f3(),
                ticklen = 3
              )
            )
          else
            p %<>% layout(
              xaxis = list(
                type = 'category',
                tickfont = f3(),
                ticklen = 3
              ),
              yaxis = list(
                type = yscale,
                tickfont = f3(),
                ticklen = 3
              )
            )

        }
      },
      'ribbon' = {
        if (legend_attr == x_attr) {
          stop("Duplicated attribute selected for x-axis and legend.")
        }
        if (is.null(upper_attr) || is.null(lower_attr)) {
          stop("No upper or lower attribute provided for ribbon-plot")
        }

        for (name in xs) {
          df_small <- df[l == name]
          legend_name <- as.character(name)
          rgba_str <-
            paste0('rgba(', paste0(col2rgb(colors[[name]]), collapse = ','), ',0.2)')
          p %<>%
            add_trace(
              data = df_small,
              x = ~ x,
              y = ~ upper,
              type = 'scatter',
              mode = 'lines',
              line = list(color = rgba_str, width = 0),
              legendgroup = legend_name,
              showlegend = F,
              name = 'upper',
              ...
            ) %>%
            add_trace(
              x = ~ x,
              y = ~ lower,
              type = 'scatter',
              mode = 'lines',
              fill = 'tonexty',
              line = list(color = 'transparent'),
              legendgroup = legend_name,
              fillcolor = rgba_str,
              showlegend = F,
              name = 'lower',
              ...
            )
        }



        if (is_new_plot) {
          p %<>% layout(
            xaxis = list(
              type = xscale,
              tickfont = f3(),
              ticklen = 3,
              autorange = ifelse(scale.reverse, "reversed", T)
            ),
            yaxis = list(
              type = yscale,
              tickfont = f3(),
              ticklen = 3
            )
          )
        }
      },
      'radar' = {
        if (legend_attr == x_attr) {
          stop("Duplicated attribute selected for x-axis and legend.")
        }
        if (is.numeric(df[['x']])) {
          if (stri_detect_regex(x_attr, "(?i)fun"))
            df <- df[, x := paste0('F', sprintf("%02d", x))]
          else if (stri_detect_regex(x_attr, "(?i)dim"))
            df <- df[, x := paste0('D', as.character(x))]
          else
            df <- df[, x := as.character(x)]
        }
        df <- df[, col := add_transparancy(colors, 0.4)[l]]
        p %<>%
          add_trace(
            data = df,
            type = 'scatterpolar',
            r = ~ y,
            theta = ~ x,
            mode = 'markers',
            #marker = list(color = 'lightgrey', size=0),
            fill = 'toself',
            connectgaps = T,
            fillcolor = ~ col,
            color = ~ l,
            colors = colors,
            name =  ~ l,
            legendgroup = ~ l,
            ...
          )
        if (is_new_plot) {
          p %<>% layout(polar = list(
            radialaxis = list(
              type = yscale,
              tickfont = f3(),
              ticklen = 3,
              autorange = ifelse(scale.reverse, "reversed", T)
            )
          ))
        }
      },
      'hist' = {
        if (legend_attr == x_attr) {
          stop("Duplicated attribute selected for x-axis and legend.")
        }
        if (!'width' %in% colnames(df)) {
          stop(
            "No 'width'-column included in the provided dataframe. This is required for a histogram-plot"
          )
        }
        p %<>%
          add_trace(
            data = df,
            x = ~ x,
            y = ~ y,
            width = ~ width,
            type = 'bar',
            name = ~ l,
            text = ~ text,
            hoverinfo = 'text',
            colors = add_transparancy(colors, 0.6),
            color = ~ l,
            marker = list(line = list(color = 'rgb(8,48,107)')),
            ...
          )

        if (is_new_plot) {
          p %<>% layout(
            xaxis = list(
              type = xscale,
              tickfont = f3(),
              ticklen = 3,
              autorange = ifelse(scale.reverse, "reversed", T)
            ),
            yaxis = list(
              type = yscale,
              tickfont = f3(),
              ticklen = 3
            )
          )
        }
      },
      'bar' = {
        if (legend_attr != x_attr) {
          warning("Inconsistent attribute selected for x-axis and legend. Using x_attr as name")
        }
        colors = add_transparancy(colors, 0.6)
        for (xv in xs) {
          p %<>%
            add_trace(
              x = xv,
              y = df[x == xv, y],
              type = 'bar',
              name = xv,
              color = colors[xv],
              marker = list(line = list(color = 'rgb(8,48,107)')),
              ...
            )
        }

        if (is_new_plot) {
          p %<>% layout(
            xaxis = list(tickfont = f3(), ticklen = 3),
            yaxis = list(
              type = yscale,
              tickfont = f3(),
              ticklen = 3
            )
          )
        }
      },
      'anim-scatter' = {
        colnames(df)[colnames(df) == frame_attr] <- "frame"
        colnames(df)[colnames(df) == symbol_attr] <- "s"
        colors = add_transparancy(colors, 0.9)
        df = df[order(frame), ]
        for (xv in xs) {
          df_sub = df[l == xv,]
          p %<>% add_trace(
            data = df_sub,
            x = ~ x,
            y = ~ y,
            type = 'scatter',
            mode = 'markers',
            marker = list(color = colors[xv],
                          symbol = ~
                            s),
            legendgroup = xv,
            frame = ~ frame,
            showlegend = F,
            name = xv
          )
        }
        p %<>% animation_opts(transition = 0)

      },
      'scatter' = {
        colnames(df)[colnames(df) == symbol_attr] <- "s"
        colors = add_transparancy(colors, 0.9)
        df = df[order(frame), ]
        for (xv in xs) {
          df_sub = df[l == xv,]
          p %<>% add_trace(
            data = df_sub,
            x = ~ x,
            y = ~ y,
            type = 'scatter',
            mode = 'markers',
            marker = list(color = colors[xv],
                          symbol = ~
                            s),
            legendgroup = xv,
            showlegend = F,
            name = xv
          )
        }
      }
    )
    return(p)
  }


#' Create the PerformViz plot
#'
#' From the paper:
#'
#' @param DSC_rank_result The result from a call to DSCtool rank service (`get_dsc_rank`)
#'
#' @return A performviz plot
#' @export
#' @examples
#' \dontrun{
#' Plot.Performviz(get_dsc_rank(dsl))
#' }
Plot.Performviz <- function(DSC_rank_result) {
  if (!requireNamespace("ComplexHeatmap", quietly = TRUE)) {
    stop(
      "Package \"ComplexHeatmap\" needed for this function to work. Please install it.",
      call. = FALSE
    )
  }
  if (!requireNamespace("reshape2", quietly = TRUE)) {
    stop("Package \"reshape2\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  if (!requireNamespace("grid", quietly = TRUE)) {
    stop("Package \"grid\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  mlist <- DSC_rank_result$ranked_matrix

  problem <- NULL #Assign variable to remove warnings
  # df_temp <- rbindlist(lapply(mlist[[problem_idx]]$result,
  #                             function(x) {
  #                               list(algorithm = x$algorithm, rank =  x$rank)
  #                             }))
  # df_temp[, problem := mlist[[problem_idx]]$problem]

  df <- rbindlist(lapply(seq(length(mlist)), function(problem_idx) {
    df_temp <- rbindlist(lapply(mlist[[problem_idx]]$result,
                                function(x) {
                                  list(algorithm = x$algorithm, rank =  x$rank)
                                }))
    df_temp[, problem := mlist[[problem_idx]]$problem]
  }))

  rank_matrix <-
    reshape2::acast(df, algorithm ~ problem, value.var = 'rank')
  df <- rank_matrix
  # colnames(df)<-index
  # rownames(df)<-vector
  # Define some graphics to display the distribution of columns
  # library(ComplexHeatmap)
  .hist = ComplexHeatmap::anno_histogram(df, gp = grid::gpar(fill = "lightblue"))
  .density = ComplexHeatmap::anno_density(df, type = "line", gp = grid::gpar(col = "blue"))
  ha_mix_top = ComplexHeatmap::HeatmapAnnotation(hist = .hist, density = .density)
  # Define some graphics to display the distribution of rows
  .violin = ComplexHeatmap::anno_density(
    df,
    type = "violin",
    gp = grid::gpar(fill = "lightblue"),
    which = "row"
  )
  .boxplot = ComplexHeatmap::anno_boxplot(df, which = "row")
  ha_mix_right = ComplexHeatmap::HeatmapAnnotation(
    violin = .violin,
    bxplt = .boxplot,
    which = "row",
    width = grid::unit(4, "cm")
  )
  # Combine annotation with heatmap
  heatmap_main <- ComplexHeatmap::Heatmap(
    df,
    name = "Ranking",
    column_names_gp = grid::gpar(fontsize = 8),
    top_annotation = ha_mix_top,
    top_annotation_height = grid::unit(3.8, "cm")
  )
  return(ComplexHeatmap::draw(
    ComplexHeatmap::`+.AdditiveUnit`(heatmap_main, ha_mix_right)
  ))
}

#' Plot the cumulative difference plot given a DataSetList.
#'
#' @param dsList A DataSetList (should consist of only one function and dimension and two algorithms).
#' @param runtime_or_target_value The target runtime or the target value
#' @param isFixedBudget Should be TRUE when target runtime is used. False otherwise.
#' @param alpha 1 minus the confidence level of the confidence band.
#' @param EPSILON If abs(x-y) < EPSILON, then we assume that x = y.
#' @param nOfBootstrapSamples The number of bootstrap samples used in the estimation.
#' @param dataAlreadyComputed If false, `generate_data.CDP` will be called to process the data.
#' @param precomputedData only needed when dataAlreadyComputed=TRUE. The result of `generate_data.CDP`.
#' @return A cumulative difference plot.
#' @export
#' @examples
#' dsl
#' dsl_sub <- subset(dsl, funcId == 1)
#' target <- 15
#'
#' Plot.cumulative_difference_plot(dsl_sub, target, FALSE)
Plot.cumulative_difference_plot <-
  function(dsList,
           runtime_or_target_value,
           isFixedBudget,
           alpha = 0.05,
           EPSILON = 1e-80,
           nOfBootstrapSamples = 1e3,
           dataAlreadyComputed = FALSE,
           precomputedData = NULL)
  {
    if (!requireNamespace("RVCompare", quietly = TRUE)) {
      stop("Package \"RVCompare\" needed for this function to work. Please install it.",
           call. = FALSE)
    }

    if (dataAlreadyComputed)
    {
      if (is.null(precomputedData))
      {
        return(NULL)
      }
      data <- precomputedData
    }
    else
    {
      data <-
        generate_data.CDP(
          dsList,
          runtime_or_target_value,
          isFixedBudget,
          alpha,
          EPSILON,
          nOfBootstrapSamples
        )
    }

    if (isFixedBudget)
    {
      subds <-
        get_FV_sample(dsList, runtime_or_target_value, output = 'long')

      algorithms <- unique(subds$ID)
    }
    else
    {
      subds <-
        get_RT_sample(dsList, runtime_or_target_value, output = 'long')

      algorithms <- unique(subds$ID)
    }





    # Convert back to list
    plot_data <- list()
    for (i in 1:ncol(data)) {
      plot_data[[i]] <- data[, i]
    }
    names(plot_data) <- colnames(data)


    # Confidence band
    trace1 <-
      list(
        x = plot_data$p,
        y = plot_data$diff_upper,
        line = list(color = "rgba(0, 0, 40, 0)"),
        mode = "lines",
        name = "Upper bound of the confidence band",
        type = "scatter"
      )
    trace3 <-
      list(
        x = plot_data$p,
        y = plot_data$diff_lower,
        connectgaps = TRUE,
        line = list(color = "rgba(0, 0, 40, 0)"),
        mode = "lines",
        name = "Lower bound of the confidence band",
        type = "scatter"
      )

    # Area in which the cumulative diference can be.
    trace4 <-
      list(
        x = c(0, 0.5, 1),
        y = c(0, 1, 0),
        line = list(color = "rgba(0, 0, 40, 0)"),
        mode = "lines",
        name = "",
        type = "scatter"
      )
    trace6 <- list(
      x = c(0, 0.5, 1),
      y = c(0, -1, 0),
      connectgaps = TRUE,
      line = list(color = "rgba(0, 0, 40, 0)"),
      mode = "lines",
      name = "",
      type = "scatter"
    )




    fig <- plotly::plot_ly() %>%
      plotly::add_lines(
        x = plot_data$p,
        y = plot_data$diff_estimation,
        color = I("black"),
        name = "Estimated cumulative diference"
      ) %>%
      plotly::add_lines(
        x = trace1$x,
        y = trace1$y,
        line = trace1$line,
        mode = trace1$mode,
        name = trace1$name,
        type = trace1$type,
        uid = trace1$uid,
        xsrc = trace1$xsrc,
        ysrc = trace1$ysrc
      ) %>%

      plotly::add_trace(
        x = trace3$x,
        y = trace3$y,
        connectgaps = trace3$connectgaps,
        line = trace3$line,
        mode = trace3$mode,
        name = trace3$name,
        type = trace3$type,
        uid = trace3$uid,
        xsrc = trace3$xsrc,
        ysrc = trace3$ysrc,
        fillcolor = "rgba(0,40,100,0.2)",
        fill = 'tonexty'
      ) %>%

      plotly::add_lines(
        x = trace4$x,
        y = trace4$y,
        line = trace4$line,
        mode = trace4$mode,
        name = trace4$name,
        type = trace4$type,
        uid = trace4$uid,
        xsrc = trace4$xsrc,
        ysrc = trace4$ysrc
      ) %>%
      plotly::add_trace(
        x = trace6$x,
        y = trace6$y,
        connectgaps = trace6$connectgaps,
        line = trace6$line,
        mode = trace6$mode,
        name = trace6$name,
        type = trace6$type,
        uid = trace6$uid,
        xsrc = trace6$xsrc,
        ysrc = trace6$ysrc,
        fillcolor = "rgba(51,204,255,0.2)",
        fill = 'tonexty'
      ) %>%


      plotly::layout(
        xaxis = list(range = c(0, 1)),
        yaxis = list(range = c(-1, 1)),
        showlegend = FALSE
      ) %>%

      plotly::add_annotations(
        x = 0.02,
        y = 0.85,
        xref = "x",
        yref = "y",
        text = algorithms[1],
        xanchor = 'left',
        showarrow = F
      ) %>%
      plotly::add_annotations(
        x = 0.02,
        y = -0.85,
        xref = "x",
        yref = "y",
        text = algorithms[2],
        xanchor = 'left',
        showarrow = F
      )

    return(fig)
  }


#' Create EAF-based polygon plots
#'
#'
#'
#' @param df The dataframe containing the data to plot. This should come from `generate_data.EAF`
#' @param subplot_attr Which attribute of the dataframe to use for creating subplots
#' @param subplot_shareX Whether or not to share X-axis when using subplots
#' @param scale.xlog Logarithmic scaling of x-axis
#' @param scale.ylog Logarithmic scaling of y-axis
#' @param xmin Minimum value for the x-axis
#' @param xmax Maximum value for the x-axis
#' @param ymin Minimum value for the y-axis
#' @param ymax Maximum value for the y-axis
#' @param maximization Whether the data comes from maximization or minimization
#' @param scale.reverse Decreasing or increasing x-axis
#' @param x_title Title of x-axis. Defaults to x_attr
#' @param y_title Title of x-axis. Defaults to x_attr
#' @param plot_title Title of x-axis. Defaults to no title
#' @param p A previously existing plot on which to add traces. If NULL, a new canvas is created
#' @param show.colorbar Whether or not to include a colorbar
#' @param dt_overlay Dataframe containing additional data (e.g. quantiles) to plot
#' on top of the EAF. This should have a column labeled 'runtime'. The other columsn will
#' all be plotted as function values.
#' @param ... Additional parameters for the add_trace function
#'
#' @return An EAF plot
#' @export
#' @examples
#' \dontrun{
#' plot_eaf_data(generate_data.EAF(subset(dsl, ID==get_id(dsl)[[1]])), maximization=T)
#' }
plot_eaf_data <-
  function(df,
           maximization = F,
           scale.xlog = F,
           scale.ylog = F,
           scale.reverse = F,
           p = NULL,
           x_title = NULL,
           xmin = NULL,
           xmax = NULL,
           ymin = NULL,
           ymax = NULL,
           y_title = NULL,
           plot_title = NULL,
           subplot_attr = NULL,
           show.colorbar = F,
           subplot_shareX = F,
           dt_overlay = NULL,
           ...) {
    l <-
      x <-
      isinf <-
      y <-
      text <-
      l_orig <- frame <- NULL #Set local binding to remove warnings

    #Deal with subplots
    if (!is.null(subplot_attr)) {
      if (!subplot_attr %in% colnames(df)) {
        stop("Provided subplot-attribut is not a colname of the selected data.table.")
      }
      colnames(df)[colnames(df) == subplot_attr] <- "subplot_attr"
      if (!is.null(dt_overlay)) {
        colnames(dt_overlay)[colnames(dt_overlay) == subplot_attr] <-
          "subplot_attr"
      }
      attrs <- unique(df[, subplot_attr])
      if (length(attrs) == 0)
        stop(
          "Attempting to create subplots with fewer than 2 unique values of
                                 `subplot_attrs`-column"
        )
      if (length(attrs) == 1)
        return(
          plot_eaf_data(
            df,
            maximization = maximization,
            scale.xlog = scale.xlog,
            scale.ylog = scale.ylog,
            scale.reverse = scale.reverse,
            p = p,
            x_title = x_title,
            xmin = xmin,
            xmax = xmax,
            ymin = ymin,
            ymax = ymax,
            y_title = y_title,
            show.colorbar = show.colorbar,
            subplot_attr = NULL,
            dt_overlay = dt_overlay,
            ...
          )
        )

      #Get some number of rows and columns
      n_cols <- 1 + ceiling(length(attrs) / 10)
      n_rows <- ceiling(length(attrs) / n_cols)

      p <- lapply(seq(length(attrs)), function(idx) {
        attr_val <- attrs[[idx]]
        df_sub <- df[subplot_attr == attr_val]
        dt_overlay_sub <- dt_overlay[subplot_attr == attr_val]
        disp_y <-  idx %% n_cols == 1
        disp_x <- idx > (length(attrs) - n_cols)
        x.title = if (disp_x)
          x_title
        else
          ""
        y.title = if (disp_y)
          y_title
        else
          ""

        #Generate title for the subplots
        if (stri_detect_regex(subplot_attr, "(?i)fun"))
          sub_title <- paste0('F', attr_val)
        else if (stri_detect_regex(subplot_attr, "(?i)dim"))
          sub_title <- paste0('D', attr_val)
        else
          sub_title <- paste0(attr_val)
        p <- NULL
        p <-
          plot_eaf_data(
            df_sub,
            maximization = maximization,
            scale.xlog = scale.xlog,
            scale.ylog = scale.ylog,
            scale.reverse = scale.reverse,
            p = p,
            x_title = x_title,
            xmin = xmin,
            xmax = xmax,
            ymin = ymin,
            ymax = ymax,
            y_title = y_title,
            show.colorbar = F,
            subplot_attr = NULL,
            dt_overlay = dt_overlay_sub,
            ...
          )
        if (getOption("IOHanalyzer.annotation_x", 0.5) >= 0 &
            getOption("IOHanalyzer.annotation_y", 1) >= 0) {
          p %<>% layout(
            annotations = list(
              text = sub_title,
              font = f2,
              showarrow = FALSE,
              xref = "paper",
              yref = "paper",
              x = getOption("IOHanalyzer.annotation_x", 0.5),
              y = getOption("IOHanalyzer.annotation_y", 1)
            )
          )
          p
        }

      })

      p <- subplot(
        p,
        nrows = n_rows,
        titleX = T,
        titleY = T,
        margin = c(
          getOption("IOHanalyzer.margin_horizontal", 0.02),
          getOption("IOHanalyzer.margin_vertical", 0.02),
          getOption("IOHanalyzer.margin_horizontal", 0.02),
          getOption("IOHanalyzer.margin_vertical", 0.02)
        ),
        shareX = subplot_shareX
      ) %>%
        layout(title = plot_title)
      return(p)
    }

    xscale <- if (scale.xlog)
      'log'
    else
      'linear'
    yscale <- if (scale.ylog)
      'log'
    else
      'linear'




    #If new plot is needed, create one. Store in bool to decide if axis scaling is needed.
    is_new_plot <- F
    if (is.null(p)) {
      p <- IOH_plot_ly_default(x.title = x_title,
                               y.title = y_title,
                               title = plot_title)
      is_new_plot <- T
    }

    eaf_sets <- df$`percentage`
    uniq_eaf_sets <- unique(eaf_sets)
    att_surfs <- split.data.frame(df[, .(`runtime`, `f(x)`)],
                                  factor(eaf_sets,
                                         levels = uniq_eaf_sets,
                                         labels = uniq_eaf_sets))
    cols <- rev(viridis(length(att_surfs)))
    if (maximization)
      extreme = as.matrix(df[, .(runtime = max(`runtime`), `f(x)` = min(`f(x)`))])
    else
      extreme = as.matrix(df[, .(runtime = max(`runtime`), `f(x)` = max(`f(x)`))])

    for (i in seq_along(att_surfs)) {
      poli <-
        add.extremes(points.steps(as.matrix(att_surfs[[i]])),
                     as.matrix(extreme),
                     c(F, maximization))
      poli <- rbind(poli, extreme)

      p %<>% add_polygons(
        poli[, 'runtime'],
        poli[, 'f(x)'],
        alpha = 1,
        fillcolor = cols[i],
        line = list(width = 0),
        name = names(att_surfs)[i],
        showlegend = F
      )
    }

    # Set axis ranges
    xmin <-
      ifelse((is.null(xmin) ||
                xmin == ""), min(df$`runtime`), as.numeric(xmin))
    xmax <-
      ifelse((is.null(xmax) ||
                xmax == ""), max(df$`runtime`), as.numeric(xmax))
    if (scale.xlog) {
      xmin <- log10(xmin)
      xmax <- log10(xmax)
    }
    ymin <-
      ifelse((is.null(ymin) ||
                ymin == ""), min(df$`f(x)`), as.numeric(ymin))
    ymax <-
      ifelse((is.null(ymax) ||
                ymax == ""), max(df$`f(x)`), as.numeric(ymax))
    if (scale.ylog) {
      ymin <- log10(ymin)
      ymax <- log10(ymax)
    }
    yrange <- c(ymin, ymax)
    if (scale.reverse)
      yrange <- rev(yrange)

    p %<>% layout(
      xaxis = list(
        type = xscale,
        tickfont = f3(),
        ticklen = 3,
        range = c(xmin, xmax)
      ),
      yaxis = list(
        type = yscale,
        tickfont = f3(),
        ticklen = 3,
        range = yrange
      )
    )

    if (!is.null(dt_overlay)) {
      cnames <- colnames(dt_overlay)
      if (!('runtime' %in% cnames)) {
        warning('dt_overlay needs to contain a columns labeled `runtime` to be used.')
      } else {
        for (cname in cnames[!(cnames %in% c('runtime', 'subplot_attr', 'ID'))]) {
          p %<>% add_trace(
            x = dt_overlay[['runtime']],
            y = dt_overlay[[cname]],
            type = 'scatter',
            mode = 'lines',
            name = cname,
            showlegend = F,
            line = list(
              width = getOption('IOHanalyzer.linewidth', 2),
              color = 'black',
              shape = 'hv'
            )
          )
        }
      }
    }
    if (show.colorbar) {
      p %<>% add_contour(
        z = matrix(-0.1, 1.1),
        zmin = -0.1,
        zmax = 1.1,
        colorscale = 'Viridis',
        contours = list(coloring = 'fill'),
        reversescale = T
      )
      p %<>% colorbar(
        cmin = -0,
        cmax = 1,
        thickness = 0.03,
        thicknessmode = 'fraction',
        len = 1,
        tickvals = c(0, 0.5, 1),
        tickmode = 'array',
        outlinewidth = 1,
        title = 'Fraction'
      )
    }

    p

    return(p)
  }



#' Create EAF-difference contour plots
#'
#'
#'
#' @param matrices The dataframes containing the data to plot. This should come from `generate_data.EAF_diff_Approximate`
#' @param scale.xlog Logarithmic scaling of x-axis
#' @param scale.ylog Logarithmic scaling of y-axis
#' @param zero_transparant Whether values of 0 should be made transparant or not
#' @param show_negatives Whether to also show negative values or not
#'
#' @return EAF difference plots
#' @export
#' @examples
#' \dontrun{
#' plot_eaf_differences(generate_data.EAF_diff_Approximate(subset(dsl, funcId == 1), 1, 50, 1, 16))
#' }
plot_eaf_differences <-
  function(matrices,
           scale.xlog = T,
           scale.ylog = F,
           zero_transparant = F,
           show_negatives = F) {
    xscale <- if (scale.xlog)
      'log'
    else
      'linear'
    yscale <- if (scale.ylog)
      'log'
    else
      'linear'


    show_colorbar <- T
    ids <- names(matrices)
    ps <- lapply(seq(length(ids)), function(idx) {
      diff <- matrices[[idx]]
      if (!show_negatives)
        diff[diff < 0] = 0
      id <- ids[[idx]]
      x <- as.numeric(colnames(diff))
      y <- as.numeric(rownames(diff))

      p <- IOH_plot_ly_default('', 'Function Evaluations', 'f(x)')
      if (zero_transparant)
        diff[diff == 0] = NaN

      if (all(is.na(diff))) {
        p %<>% add_trace(
          z = 0,
          type = "contour",
          x = x,
          y = y,
          line = list(smoothing = 0),
          contours = list(
            start = ifelse(show_negatives, -1, 0),
            end = 1,
            coloring = 'fill',
            showlines = F
          ),
          colorscale = ifelse(show_negatives, 'BuRd_r' , 'Viridis'),
          reversescale = show_negatives,
          name = id
        )
      } else {
        p %<>% add_trace(
          z = diff,
          type = "contour",
          x = x,
          y = y,
          line = list(smoothing = 0),
          contours = list(
            start = ifelse(show_negatives, -1, 0),
            end = 1,
            coloring = 'fill',
            showlines = F
          ),
          colorscale = ifelse(show_negatives, 'BuRd_r' , 'Viridis'),
          reversescale = show_negatives,
          name = id
        )
      }
      p %<>% layout(yaxis = list(type = yscale, ticklen = 3))
      p %<>% layout(xaxis = list(type = xscale, ticklen = 3))
      if (show_colorbar) {
        show_colorbar <<- F
      } else {
        p %<>% hide_colorbar()
      }

      if (getOption("IOHanalyzer.annotation_x", 0.5) >= 0 &
          getOption("IOHanalyzer.annotation_y", 1) >= 0) {
        p %<>% layout(
          annotations = list(
            text = id,
            font = f2,
            showarrow = FALSE,
            xref = "paper",
            yref = "paper",
            x = getOption("IOHanalyzer.annotation_x", 0.5),
            y = getOption("IOHanalyzer.annotation_y", 1)
          )
        )
      }

      # p %<>% add_trace(x=x, y=fv_sum[ , .(max = max(max)), by = runtime]$max, color='white', type = "scatter", mode = "line", showlegend=F, alpha=0.4, name='max')
      # p %<>% add_trace(x=x, y=fv_sum[ , .(min = min(min)), by = runtime]$min, color='white', type = "scatter", mode = "line", showlegend=F, alpha=0.4, name='min')
      p
    })

    n_cols <- 1 + ceiling(length(matrices) / 10)
    n_rows <- ceiling(length(matrices) / n_cols)
    p <- subplot(
      ps,
      nrows = n_rows,
      titleX = T,
      titleY = T,
      margin = c(
        getOption("IOHanalyzer.margin_horizontal", 0.02),
        getOption("IOHanalyzer.margin_vertical", 0.02),
        getOption("IOHanalyzer.margin_horizontal", 0.02),
        getOption("IOHanalyzer.margin_vertical", 0.02)
      ),
      shareX = T,
      shareY = T
    )
    p

    return(p)
  }
IOHprofiler/IOHanalyzer documentation built on Feb. 1, 2024, 11:35 a.m.