Merge pull request #21 from IDEMSInternational/sub_branch

Fixing warnings in updating documentation

NAMESPACE

@@ -2,6 +2,7 @@
 
 export("%>%")
 export(BIAS)
+export(DataBook)
 export(DataSheet)
 export(EDI)
 export(EDS)
@@ -22,14 +23,17 @@ export(VE)
 export(count_calc)
 export(cp)
 export(d)
+export(get_summary_calculation_names)
 export(hss)
 export(instat_comment)
 export(link)
 export(mNSE)
 export(mae)
 export(md)
 export(me)
+export(missing_values_check)
 export(mse)
+export(na_check)
 export(nrmse)
 export(p10)
 export(p20)
@@ -78,6 +82,7 @@ export(summary_median_absolute_deviation)
 export(summary_median_circular)
 export(summary_min)
 export(summary_min_circular)
+export(summary_mode)
 export(summary_n_distinct)
 export(summary_nth)
 export(summary_outlier_limit)

R/data_sheet.R

@@ -180,16 +180,13 @@
 #'   \item{\code{has_labels(col_names)}}{Checks if the specified columns have labels.}
 #'   \item{\code{display_daily_table(data_name, climatic_element, date_col = date_col, year_col = year_col, station_col = station_col, Misscode, Tracecode, Zerocode, monstats = c("min", "mean", "median", "max", "IQR", "sum"))}}{Display a daily summary table for a specified climatic data element.}
 #'  
-#'   # related to instat_comments.R file in R-Instat
 #'   \item{\code{add_comment(new_comment)}}{Adds a new `instat_comment` object to the data sheet if the key is defined and valid.}
 #'   \item{\code{delete_comment(comment_id)}}{Deletes a comment from the data sheet based on the comment ID.}
 #'   \item{\code{get_comment_ids()}}{Retrieves all comment IDs currently stored in the data sheet.}
 #'   \item{\code{get_comments_as_data_frame()}}{Converts all comments in the data sheet to a data frame format for easier inspection and analysis.}
 #'
-#'   # related to calculation.R file in R-Instat
 #'   \item{\code{save_calculation(calc)}}{Save a Calculation to the DataSheet.}
 #'   
-#'   # related to summary_functions.R file in R-Instat
 #'   \item{\code{merge_data(new_data, by = NULL, type = "left", match = "all")}{Merge New Data with Existing Data}}
 #'   \item{\code{calculate_summary(calc, ...)}{Calculate Summaries for Specified Columns}}
 #' }

R/instat_comment.R

@@ -2,7 +2,21 @@
 #'
 #' @description
 #' The `instat_comment` R6 class represents a comment in a data sheet, with various properties including identifiers, key-value pairs, comment details, timestamps, and status flags for resolution and activity.
-#'
+#' 
+#' @field id A numeric/character string representing the unique identifier for the comment. This must be unique within a data frame.
+#' @field key_values A character vector storing key-value pairs associated with the comment. This identifies the row the comment is on.
+#' @field column If the comment is on a cell, this is the name of the column of the cell
+#' @field value If the comment is on a cell, this is the value in the cell at the time the comment was created.
+#' @field type The type of comment (`"critical"`, `"warning"`, `"message"`, or `""`).
+#' @field comment A character string for the comment text or message.
+#' @field label A character variable. A label or grouping for the comment e.g. if comments are produced by an operation they may all have the same label. This then allows similar comments to be identified e.g. for editing/deleting
+#' @field calculation A character variable. If the comment was created through a calculation e.g. filtering the data frame, this shows how the calculation done on the data frame
+#' @field time_stamp The date and time (`POSIXct`, `POSIXt`) the comment was created, defaulting to the current system time if empty.
+#' @field replies A list of replies to the comment. A reply could be a comment itself
+#' @field resolved Logical value indicating if the comment is marked as resolved (`TRUE` or `FALSE`).
+#' @field active Logical value indicating if the comment is marked as active (`TRUE` or `FALSE`).
+#' @field attributes A named list of additional information about the comment.
+#' 
 #' @section Methods:
 #' \describe{
 #'   \item{\code{data_clone(...)}}{Creates a deep clone of the current `instat_comment` object, including all of its fields and nested `instat_comment` replies.}
@@ -74,6 +88,7 @@ instat_comment <- R6::R6Class("instat_comment",
 
                                 #' @title Clone `instat_comment` Object
                                 #' @description Creates a deep clone of the current `instat_comment` object, including all of its fields and nested `instat_comment` replies.
+                                #' @param ... Additional parameters to read in
                                 #' @details The `data_clone` method duplicates the current `instat_comment` object, ensuring any `instat_comment` instances within the `replies` field are recursively cloned. Non-`instat_comment` replies are directly copied without cloning.
                                 #' @return A new `instat_comment` object with the same field values as the original, including a cloned list of `replies`.
                                 #' 

R/link.R

@@ -3,6 +3,11 @@
 #' @description
 #' The `link` R6 class represents a relationship between two data frames, defined by link attributes and the columns used to link them.
 #'
+#' @field from_data_frame A character string representing the name of the first data frame in the link.
+#' @field to_data_frame A character string representing the name of the second data frame in the link.
+#' @field type A character string representing the type of link, e.g., "keyed".
+#' @field link_columns A list where each element defines a way to link the data frames, with each element as a named character vector.
+#'
 #' @section Methods:
 #' \describe{
 #'   \item{\code{data_clone(...)}}{Creates a deep clone of the current `link` object, including all its fields.}
@@ -36,8 +41,11 @@ link <- R6::R6Class("link",
                       type = "",
                       link_columns = list(),
 
-                      #' @title Clone `link` Object
-                      #' @description Creates a deep clone of the current `link` object, including all its fields.
+                      #' Clone `link` Object.
+                      #' @description
+                      #' Creates a deep clone of the current `link` object, including all its fields.
+                      #' @param ... Additional parameters to read in
+                      #' 
                       #' @return A new `link` object with the same field values as the original.
                       data_clone = function(...) {
                         ret <- link$new(
@@ -49,17 +57,21 @@ link <- R6::R6Class("link",
                         return(ret)
                       },
 
-                      #' @title Rename Data Frame in Link
-                      #' @description Renames the specified data frame in the link.
+                      #' Rename a Data Frame in the Link.
+                      #' @description
+                      #' Renames the specified data frame in the link.
+                      #'
                       #' @param old_data_name The current name of the data frame to be renamed.
                       #' @param new_data_name The new name for the data frame.
                       rename_data_frame_in_link = function(old_data_name, new_data_name) {
                         if (self$from_data_frame == old_data_name) self$from_data_frame <- new_data_name
                         if (self$to_data_frame == old_data_name) self$to_data_frame <- new_data_name
                       },
 
-                      #' @title Rename Column in Link
-                      #' @description Renames a column involved in the link between data frames.
+                      #' Rename a Column in the Link.
+                      #' @description
+                      #' Renames a column involved in the link between data frames.
+                      #'
                       #' @param data_name The name of the data frame where the column is located.
                       #' @param old_column_name The current name of the column to be renamed.
                       #' @param new_column_name The new name for the column.
@@ -75,7 +87,5 @@ link <- R6::R6Class("link",
                           }
                         }
                       }
-                    ),
-                    private = list(),
-                    active = list()
+                    )
 )

R/summary_functions.R

@@ -1,3 +1,110 @@
+#' Get Summary Calculation Names
+#'
+#' Generates a set of unique names for summary calculations, based on provided summaries, columns, and filters.
+#'
+#' @param calc A calculation object (unused in the current implementation).
+#' @param summaries A vector of summary function names.
+#' @param columns_to_summarise A vector of column names to summarize.
+#' @param calc_filters A list of filter objects applied to the calculations.
+#' @return A character vector of unique summary calculation names.
+#' @export
+get_summary_calculation_names <- function(calc, summaries, columns_to_summarise, calc_filters) {
+  filter_description <- ""
+  i = 1
+  for(filt in calc_filters) {
+    if(!filt$parameters[["is_no_filter"]]) {
+      if(i == 1) filter_description <- filt$name
+      else filter_description <- paste(filter_description, filt$name, sep = ".")
+    }
+    i = i + 1
+  }
+  if(filter_description == "") {
+    out <- apply(expand.grid(paste0(substring(summaries, 9),"."), columns_to_summarise), 1, paste, collapse="")
+  }
+  else out <- apply(expand.grid(paste0(substring(summaries, 9),"."), paste0(columns_to_summarise, "_"), filter_description), 1, paste, collapse="")
+  out <- make.names(out)
+  return(out)
+}
+
+
+#' Check for Missing Values
+#'
+#' A placeholder function that always returns `FALSE`.
+#'
+#' @param x A vector to check for missing values.
+#' @return Logical. Always returns `FALSE`.
+#' @export
+missing_values_check <- function(x) {
+  return(FALSE)
+}
+
+#' Calculate Mode
+#'
+#' Determines the mode (most frequent value) of a vector.
+#'
+#' @param x A vector of data.
+#' @param ... Additional arguments (unused).
+#' @return The mode of the vector. Returns `NA` if the input is `NULL`.
+#' @export
+summary_mode <- function(x,...) {
+  ux <- unique(x)
+  out <- ux[which.max(tabulate(match(x, ux)))]
+  if(is.factor(x)) out <- as.character(out)
+  if(is.null(out)) return(NA)
+  else return(out)
+}
+
+#' Check Missing Values Based on Conditions
+#'
+#' Evaluates a vector against specified conditions for missing values.
+#'
+#' @param x A vector to check for missing values.
+#' @param na_type A character vector specifying the types of checks to perform. Options include:
+#'   \itemize{
+#'     \item `"n"`: Total number of missing values (`<= na_max_n`).
+#'     \item `"prop"`: Proportion of missing values (`<= na_max_prop` in percentage).
+#'     \item `"n_non_miss"`: Minimum number of non-missing values (`>= na_min_n`).
+#'     \item `"FUN"`: A custom function to evaluate missing values.
+#'     \item `"con"`: Maximum consecutive missing values (`<= na_consecutive_n`).
+#'   }
+#' @param na_consecutive_n Optional. Maximum allowed consecutive missing values.
+#' @param na_max_n Optional. Maximum allowed missing values.
+#' @param na_max_prop Optional. Maximum allowed proportion of missing values (in percentage).
+#' @param na_min_n Optional. Minimum required non-missing values.
+#' @param na_FUN Optional. A custom function to evaluate missing values.
+#' @param ... Additional arguments passed to the custom function `na_FUN`.
+#' @return Logical. Returns `TRUE` if all specified checks pass, otherwise `FALSE`.
+#' @export
+na_check <- function(x, na_type = c(), na_consecutive_n = NULL, na_max_n = NULL, na_max_prop = NULL, na_min_n = NULL, na_FUN = NULL, ...) {
+  res <- c()
+  for (i in seq_along(na_type)) {
+    type <- na_type[i]
+    if (type %in% c("n","'n'")) {
+      res[i] <- summary_count_missing(x) <= na_max_n
+    }
+    else if (type %in% c("prop","'prop'")) {
+      res[i] <- (summary_count_missing(x) / summary_count(x)) <= na_max_prop / 100
+    }
+    else if (type %in% c("n_non_miss","'n_non_miss'")) {
+      res[i] <- summary_count_non_missing(x) >= na_min_n
+    }
+    else if (type %in% c("FUN","'FUN'")) {
+      res[i] <- na_FUN(x, ...)
+    }
+    else if (type %in% c("con","'con'")) {
+      is_na_rle <- rle(is.na(x))
+      res[i] <- max(is_na_rle$lengths[is_na_rle$values]) <= na_consecutive_n
+    }
+    else {
+      stop("Invalid na_type specified for missing values check.")
+    }
+    if (!res[i]) {
+      return(FALSE)
+    }
+  }
+  return(all(res))
+}
+
 #' Calculate the Mean of Circular Data
 #'
 #' Computes the mean of circular data using `circular::mean.circular`.
@@ -14,8 +121,6 @@ summary_mean_circular <- function (x, na.rm = FALSE, control.circular = list(),
   else return(circular::mean.circular(x, na.rm = na.rm, trim = trim, control.circular = control.circular)[[1]])
 }
 
-
-
 #' Calculate the Median of Circular Data
 #'
 #' Computes the median of circular data using `circular::median.circular`.