Merge pull request #23 from dereckmezquita/STAT-2-R-pkg-dmplot-Volcan…

…o-and-Pca-classes

STAT-2: volcano and pca classes

.Rbuildignore

@@ -7,4 +7,5 @@
 ^dev$
 ^\.github$
 ^_pkgdown\.yml$
-^docs$
+^docs$
+^.*\.csv$

.gitignore

@@ -1,6 +1,9 @@
-docs/
+# dev
 deprecated/
-.DS_Store
+*.ignore
+
+# build
+docs/
 *html
 .vscode/
 
@@ -54,3 +57,6 @@ vignettes/*.pdf
 
 # R Environment Variables
 .Renviron
+
+# machine
+.DS_Store

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dmplot
-Title: A Framework and Toolkit for Financial and Time Series Data
-Version: 1.7.1
+Title: Framework written in high-performance C++ and ggplot2 for financial, bioinformatics, and time series data analysis
+Version: 1.8.0
 URL: https://github.com/dereckmezquita/dmplot
 Authors@R: 
     person(given = "Dereck",
@@ -9,18 +9,21 @@ Authors@R:
            email = "[email protected]",
            comment = c(ORCID = "0000-0002-9307-6762"))
 Maintainer: Dereck Mezquita <[email protected]>
-Description: A plotting toolkit for financial and time series data. The package provides algorithms, functions, layers and outlines a framework for working with and analysing financial and time series data. The package also includes high-performance functions for calculating technical indicators written in C++.
-Depends: R (>= 4.1.0)
-LinkingTo: Rcpp
-Imports:
-    ggplot2 (>= 3.4.0),
-    Rcpp (>= 1.0.12),
-    data.table
+Description: A comprehensive framework for analysing and visualising financial, bioinformatics, and time series data. Leveraging high-performance C++ and the ggplot2 library, dmplot offers powerful data processing capabilities, including technical indicators implemented in C++ for speed. The package features stateful plotting classes (using R6) for advanced visualisations such as Monte Carlo simulations and bioinformatics data representation.
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 VignetteBuilder: knitr
 RoxygenNote: 7.3.2
+Depends: R (>= 4.1.0)
+LinkingTo: Rcpp
+Imports:
+    ggplot2 (>= 3.4.0),
+    Rcpp (>= 1.0.12),
+    data.table,
+    R6,
+    stringr,
+    rlang
 Suggests:
     knitr,
     rmarkdown,
@@ -30,7 +33,9 @@ Suggests:
     remotes,
     gridExtra,
     testthat (>= 3.0.0),
-    microbenchmark
+    microbenchmark,
+    lubridate,
+    crayon
 Remotes:
     dereckmezquita/kucoin
 Config/testthat/edition: 3

NAMESPACE

@@ -1,13 +1,25 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(is.empty,character)
+S3method(is.empty,data.frame)
+S3method(is.empty,default)
+S3method(is.empty,factor)
+S3method(is.empty,list)
+S3method(is.empty,matrix)
+S3method(is.empty,vector)
+export(Comparison)
 export(MonteCarlo)
+export(Pca)
+export(Volcano)
 export(bb)
 export(cite_package)
 export(ema)
 export(fib)
+export(is.empty)
 export(macd)
 export(mom)
 export(monte_carlo)
+export(printCapture)
 export(roc)
 export(rsi)
 export(sma)
@@ -18,6 +30,8 @@ export(stat_movingaverages)
 export(stat_shade_ranges)
 export(theme_dereck_dark)
 export(theme_dereck_light)
+export(to.data.frame)
+export(valueCoordinates)
 import(data.table)
 import(ggplot2)
 importFrom(Rcpp,evalCpp)

R/Comparison.R

@@ -0,0 +1,139 @@
+#' Comparison Class
+#'
+#' An R6 class that represents a comparison between two groups of samples.
+#' This class contains the comparison name, the group order, and the comparison table.
+#' It includes methods to initialise, print, and validate the data.
+#'
+#' @field comparison_name Character. The name of the comparison.
+#' @field group_order Character vector. The order of groups for the comparison, with length 2. 
+#'        The first element is treated as the "control" group, and the second as the "test" group.
+#' @field comparison_table A data.table that contains the group, sample, and condition information for the comparison.
+#' 
+#' @examples
+#' comparison <- Comparison$new(
+#'   comparison_name = "Treatment vs Control",
+#'   group_order = c("Control", "Treatment"),
+#'   comparison_table = data.table::data.table(
+#'     group = c("Control", "Control", "Treatment", "Treatment"),
+#'     sample = c("Sample1", "Sample2", "Sample3", "Sample4")
+#'   )
+#' )
+#' print(comparison)
+#'
+#' @export
+Comparison <- R6::R6Class(
+    "Comparison",
+    public = list(
+        comparison_name = NA_character_,
+        group_order = c(NA_character_, NA_character_),
+        comparison_table = data.table::data.table(),
+        #' @description
+        #' Create a new Comparison object.
+        #'
+        #' @param comparison_name A character string representing the name of the comparison. 
+        #'        Must be of length 1 and not exceed 100 characters.
+        #' @param group_order A character vector specifying the order of groups for the comparison. 
+        #'        Must be of length 2.
+        #' @param comparison_table A data.table that contains group and sample information for the comparison. 
+        #'        It should have two columns, named "group" and "sample". The "group" column identifies 
+        #'        the clinical group to which each sample belongs, and the "sample" column lists the 
+        #'        names/IDs of the samples. The groups in this table should match the names specified 
+        #'        in `group_order`.
+        initialize = function(
+            comparison_name,
+            group_order,
+            comparison_table
+        ) {
+            if (
+                missing(comparison_name) ||
+                missing(group_order) ||
+                missing(comparison_table)
+            ) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: missing arguments; "comparison_name", "group_order", "comparison_table" must be provided.'))
+            }
+
+            data.table::setDT(comparison_table)
+
+            self$comparison_name <- comparison_name
+            self$group_order <- group_order
+            self$comparison_table <- comparison_table
+
+            map <- self$group_order %in% self$comparison_table$group
+            if (!any(map)) {
+                rlang::abort(stringr::str_interp('${self$group_order}: group_order lists comparisons not in the comparison_table; these were not found: ${collapse(self$group_order[!map])}'))
+            }
+
+            # filter comparison table for only those groups listed
+            self$comparison_table <- self$comparison_table[
+                group %in% self$group_order,
+            ]
+
+            data.table::setorderv(self$comparison_table, c("group", "sample"))
+
+            derived_groups <- paste(c("control - ", self$group_order[1], ", test - ", self$group_order[2]), collapse = "")
+            message(stringr::str_interp('${self$comparison_name}: deriving condition "control", "test" from group_order argument: ${derived_groups}'))
+
+            self$comparison_table$condition <- "test"
+            # TODO: revise to use data.table
+            self$comparison_table[
+                self$comparison_table$group == self$group_order[1],
+                "condition"
+            ] <- "control"
+
+            # convert to factor
+            self$comparison_table[
+                , condition := factor(condition, levels = c("control", "test"))
+            ]
+
+            private$validate()
+        },
+        #' Print a summary of the Comparison object.
+        #' @return None. This method is called for its side effect of printing to the console.
+        print = function() {
+            cat("Comparison R6 object\n")
+            cat("-----------------\n")
+            cat("Comparison Name: ", self$comparison_name, "\n")
+            cat("Group Order: ", paste(self$group_order, collapse = ", "), "\n")
+            cat("Comparison Table:\n")
+            cat(printCapture(self$comparison_table), "\n")
+        }
+    ),
+    private = list(
+        #' Validate the Comparison object.
+        validate = function() {
+            if (length(self$comparison_name) != 1) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: "comparison_name" must be of type character length 1.'))
+            }
+
+            if (nchar(self$comparison_name) > 100) {
+                rlang::warn(stringr::str_interp('${self$comparison_name}: "comparison_name" might be too long for practical use.'))
+            }
+
+            if (length(self$group_order) != 2) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: "group_order" must be of type character length 2; groups received: ${collapse(self$group_order)}'))
+            }
+
+            not_found <- !self$group_order %in% self$comparison_table$group
+            if (any(not_found)) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: "group_order" lists groups not found in the "comparison_table"; missing: ${collapse(self$group_order[not_found])}'))
+            }
+
+            if (ncol(self$comparison_table) != 3) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: "comparison_table" must have two columns.'))
+            }
+
+            if (any(!c("group", "sample") %in% colnames(self$comparison_table))) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: "comparison_table" must have colnames: "group", "sample".'))
+            }
+
+            if (length(unique(self$comparison_table$group)) != length(unique(self$group_order))) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: "comparison_table" does not list the same number of unique groups as "group_order": ${collapse(unique(self$comparison_table$group))}'))
+            }
+
+            dup_map <- duplicated(self$comparison_table$sample)
+            if (any(dup_map)) {
+                rlang::abort(stringr::str_interp('${self$comparison_name}: slot "comparison_name" lists duplicate samples; received duplicates: ${collapse(self$comparison_table$sample[dup_map])}'))
+            }
+        }
+    )
+)

R/MonteCarlo.R

@@ -24,15 +24,15 @@ MonteCarlo <- R6::R6Class(
     private = list(
         validate_data = \() {
             if (!inherits(self$data, "data.table")) {
-                rlang::abort("data must be a data.table")
+                stop("data must be a data.table")
             }
             required_cols <- c(
                 "symbol", "datetime", "open", "high",
                 "low", "close", "volume", "turnover"
             )
 
             if (!all(required_cols %in% colnames(self$data))) {
-                rlang::abort("data must contain the following columns: ", paste(required_cols, collapse = ", "))
+                stop("data must contain the following columns: ", paste(required_cols, collapse = ", "))
             }
         },
         prepare = \(log_historical = FALSE) {
@@ -134,7 +134,7 @@ MonteCarlo <- R6::R6Class(
         #' @return A ggplot object showing the simulated price paths.
         plot_prices = \() {
             if (is.null(self$simulation_results) || is.null(self$end_prices)) {
-                rlang::abort("Must run simulation first")
+                stop("Must run simulation first")
             }
 
             self$simulation_results |>
@@ -154,7 +154,7 @@ MonteCarlo <- R6::R6Class(
         #' @return A ggplot object showing the distribution of final prices.
         plot_distribution = \() {
             if (is.null(self$simulation_results) || is.null(self$end_prices)) {
-                rlang::abort("Must run simulation first")
+                stop("Must run simulation first")
             }
 
             self$end_prices |>
@@ -180,7 +180,7 @@ MonteCarlo <- R6::R6Class(
         #' @return A ggplot object showing historical and simulated prices.
         plot_prices_and_predictions = \() {
             if (is.null(self$simulation_results) || is.null(self$end_prices)) {
-                rlang::abort("Must run simulation first")
+                stop("Must run simulation first")
             }
 
             scale_period <- ""