V0.5.2 beta

NAMESPACE

@@ -9,12 +9,9 @@ export(dm_add_attribute)
 export(dm_apply_mask)
 export(dm_check_integrity)
 export(dm_colClasses)
-export(dm_default_fun)
-export(dm_default_val)
 export(dm_filter)
-export(dm_filter_set)
 export(dm_get_default)
-export(dm_inputs_ui)
+export(dm_migrate)
 export(dm_name)
 export(dm_skip)
 export(dm_table_mask)
@@ -28,10 +25,10 @@ export(item_create)
 export(item_delete)
 export(item_load)
 export(item_save)
+export(item_sort)
 export(item_update)
 export(items_filtered_view_DT)
 export(items_name)
-export(items_view_DT)
 export(kitemsManager_Server)
 export(runExample)
 export(update_BTN)

R/data.R

@@ -12,8 +12,7 @@ OBJECT_CLASS <- c("numeric",
                   "character",
                   "factor",
                   "Date",
-                  "POSIXct",
-                  "POSIXlt")
+                  "POSIXct")
 
 # -- Define list of as functions
 CLASS_FUNCTIONS <- list("numeric" = "as.numeric",
@@ -22,33 +21,66 @@ CLASS_FUNCTIONS <- list("numeric" = "as.numeric",
                         "character" = "as.character",
                         "factor" = "as.factor",
                         "Date" = ".Date",
-                        "POSIXct" = "as.POSIXct",
-                        "POSIXlt" = "as.POSIXlt")
+                        "POSIXct" = "as.POSIXct")
+
+# -- Define list of examples #281
+CLASS_EXAMPLES <- list("numeric" = 10.5,
+                       "integer" = 2,
+                       "logical" = TRUE,
+                       "character" = "mango",
+                       "factor" = "- (NA, a factor can't be displayed here)",
+                       "Date" = as.Date(Sys.Date()),
+                       "POSIXct" = as.POSIXct(Sys.time()))
 
 
 # --------------------------------------------------------------------------
 # Declare config parameters:
 # --------------------------------------------------------------------------
 
 # -- Default values
-DEFAULT_VALUES <- list("numeric" = c(NA, 0),
-                       "integer" = c(NA, 0),
-                       "logical" = c(NA, FALSE, TRUE),
-                       "character" = c(NA, ""),
-                       "factor" = c(NA),
-                       "Date" = c(NA),
-                       "POSIXct" = c(NA),
-                       "POSIXlt" = c(NA))
+DEFAULT_VALUES <- list("numeric" = 0,
+                       "integer" = 0,
+                       "logical" = FALSE,
+                       "character" = "",
+                       "factor" = NULL,
+                       "Date" = Sys.Date(),
+                       "POSIXct" = Sys.time())
 
 # -- Default functions
-DEFAULT_FUNCTIONS <- list("numeric" = c(NA),
-                          "integer" = c(NA),
-                          "logical" = c(NA),
-                          "character" = c(NA),
-                          "factor" = c(NA),
-                          "Date" = c("Sys.Date"),
-                          "POSIXct" = c("Sys.Date"),
-                          "POSIXlt" = c("Sys.Date"))
+DEFAULT_FUNCTIONS <- list("numeric" = NULL,
+                          "integer" = NULL,
+                          "logical" = NULL,
+                          "character" = NULL,
+                          "factor" = NULL,
+                          "Date" = "Sys.Date",
+                          "POSIXct" = c("Sys.time", "Sys.Date"))
+
+
+# --------------------------------------------------------------------------
+# Declare data model structure:
+# --------------------------------------------------------------------------
+
+# -- colClasses
+DATA_MODEL_COLCLASSES <- list(name = "character",
+                              type = "character",
+                              default.val = "character",
+                              default.fun = "character",
+                              default.arg = "character",
+                              filter = "logical",
+                              skip = "logical",
+                              sort.rank = "numeric",
+                              sort.desc = "logical")
+
+# -- default values
+DATA_MODEL_DEFAULTS <- list(name = NA,
+                            type = NA,
+                            default.val = NA,
+                            default.fun = NA,
+                            default.arg = NA,
+                            filter = FALSE,
+                            skip = FALSE,
+                            sort.rank = NA,
+                            sort.desc = NA)
 
 
 # --------------------------------------------------------------------------
@@ -79,6 +111,9 @@ TEMPLATE_DATA_MODEL <- data.frame(name = c("date",
                                                   "ktools::getTimestamp", rep(NA, 5),
                                                   rep(NA, 2)),
 
+                                  # -- added #63
+                                  default.arg = rep(NA, 16),
+
                                   # -- added #220
                                   filter = c(FALSE,
                                              rep(FALSE, 7),
@@ -89,5 +124,11 @@ TEMPLATE_DATA_MODEL <- data.frame(name = c("date",
                                   skip = c(FALSE,
                                            rep(FALSE, 7),
                                            TRUE, rep(FALSE, 5),
-                                           rep(FALSE, 2)))
+                                           rep(FALSE, 2)),
+
+                                  # -- added #239
+                                  sort.rank = rep(NA, 16),
+
+                                  # -- added #239
+                                  sort.desc = rep(NA, 16))
 

R/data_model.R

@@ -5,8 +5,11 @@
 #' @param colClasses a \emph{mandatory} named vector of classes, defining the data model.
 #' @param default.val an optional named vector of values, defining the default values.
 #' @param default.fun an optional named vector of functions, defining the default functions to be used to generate default values.
+#' @param default.arg an optional named vector of arguments, to pass along with the default function.
 #' @param filter an optional character vector, indicating which attribute names should be filtered from the table view.
 #' @param skip an optional character vector, indicating which attribute names should be skipped from the user input form.
+#' @param sort.rank an optional named numeric vector, to define sort orders.
+#' @param sort.desc an optional named logical vector, to define if sort should be descending.
 #'
 #' @return a data.frame containing the data model.
 #'
@@ -16,56 +19,93 @@
 #' colClasses will be used to create the data.frame: names will define the attributes of the data model,
 #' and values will define the class (type) of the attributes.
 #'
-#' All other parameters are optional. When provided, they will be used matching names defined in colClasses, so:
-#' - order in those vectors doesn't matter,
-#' - no need to set values for all attributes (see examples),
-#' - names in those vectors not matching with colClasses names will be ignored.
+#' All default.* parameters are optional. When provided, they will be used to match with names defined in colClasses:
+#' - order in those vectors doesn't matter
+#' - there is no need to set values for all attributes (see examples)
+#' - names in vectors not matching with colClasses names will be ignored
+#'
+#' default.fun and default.val are mutual exclusive, with priority on default.fun (default.val will be forced to NA)
+#' default.arg requires default.fun not to be NULL (will be forced to NA otherwise)
+#'
+#' filter and skip directly contains the names of the attributes to set to TRUE
+#'
 #' If not provided, defaults will be applied:
-#' - NA for default.val and default.fun,
-#' - FALSE for filter and skip.
+#' - NA for default.val, default.fun and default.arg
+#' - FALSE for filter and skip
 #'
 #' @examples
-#' # order in vectors doesn't matter:
+#' # -- order in vectors doesn't matter:
 #' default.val <- c("name" = "test", "total" = 2)
 #' default.val <- c("total" = 2, "name" = "test")
 #'
-#' # no need to set all values
+#' # -- no need to set all values
 #' colClasses <- c("id" = "numeric", "name" = "character", "total" = "numeric")
 #' default.val <- c("name" = "test", "total" = 2)
 #'
-#' data_model(colClasses, default.val, default.fun = NULL)
+#' # -- filter and skip
+#' filter <- "id"
+#' skip <- c("id", "date")
+#'
+#' # -- sort
+#' sort.rank = c("date" = 1, "total" = 2, "name" = 3)
+#' sort.desc = c("date" = TRUE, "total" = FALSE)
+#'
+#' data_model(colClasses, default.val, filter = filter, skip = skip)
 #'
 
-data_model <- function(colClasses, default.val = NULL, default.fun = NULL, filter = NULL, skip = NULL){
+data_model <- function(colClasses, default.val = NULL, default.fun = NULL, default.arg = NULL,
+                       filter = NULL, skip = NULL,
+                       sort.rank = NULL, sort.desc = NULL){
 
   # -- check arg #217
   if(is.null(names(colClasses)))
     stop("colClasses must be a named vector")
 
+  # -- make sure default.val & fun are mutual exclusive
+  if(any(names(default.val) %in% names(default.fun)))
+    default.val <- default.val[!names(default.val) %in% names(default.fun)]
+
+
   # -- Build data.frame from colClasses (named vector)
   dm <- data.frame("name" = names(colClasses), "type" = unname(colClasses))
 
   # -- Add default.val (match input with names)
-  if(!is.null(default.val))
-    dm$default.val <- default.val[match(dm$name, names(default.val))]
+  if(isTruthy(default.val))
+    dm$default.val <- as.character(default.val[match(dm$name, names(default.val))])
   else
     dm$default.val <- NA
 
   # -- Add default.fun (match input with names)
-  if(!is.null(default.fun))
-    dm$default.fun <- default.fun[match(dm$name, names(default.fun))]
+  if(isTruthy(default.fun))
+    dm$default.fun <- as.character(default.fun[match(dm$name, names(default.fun))])
   else
     dm$default.fun <- NA
 
+  # -- Add default.arg (match input with names)
+  if(isTruthy(default.arg))
+    dm$default.arg <- as.character(default.arg[match(dm$name, names(default.arg))])
+  else
+    dm$default.arg <- NA
+
   # -- Add filter (match input with names)
   dm$filter <- dm$name %in% filter
 
   # -- Add skip (match input with names)
   dm$skip <- dm$name %in% skip
 
+  # -- Add sort.rank (match input with names)
+  if(isTruthy(sort.rank))
+    dm$sort.rank <- as.numeric(sort.rank[match(dm$name, names(sort.rank))])
+  else
+    dm$sort.rank <- NA
+
+  # -- Add sort.desc (match input with names)
+  if(isTruthy(sort.desc))
+    dm$sort.desc <- as.logical(sort.desc[match(dm$name, names(sort.desc))])
+  else
+    dm$sort.desc <- NA
+
   # -- Return
   dm
 
 }
-
-

R/dm_add_attribute.R

@@ -5,54 +5,45 @@
 #' @param data.model a \emph{mandatory} data model, structured as an output of data_model() function
 #' @param name a \emph{mandatory} character string for the new attribute name
 #' @param type a \emph{mandatory} character string for the new attribute type
-#' @param default.val an optional default value
-#' @param default.fun an optional default function
-#' @param skip an optional logical value (default = FALSE) if the attribute should be skipped in the input form
-#' @param filter an optional logical value (default = FALSE) if the attribute should be masked in the filtered view
+#' @param default.val an optional named vector of values, defining the default values.
+#' @param default.fun an optional named vector of functions, defining the default functions to be used to generate default values.
+#' @param default.arg an optional named vector of arguments, to pass along with the default function.
+#' @param skip an optional character vector, with the name(s) of the attribute(s) to skip
+#' @param filter an optional character vector, with the name(s) of the attribute(s) to filter
+#' @param sort.rank an optional named numeric vector, to define sort orders
+#' @param sort.desc an optional named logical vector, to define if sort should be descending
 #'
 #' @return the updated data model
 #' @export
 #'
+#' @seealso [data_model()]
+#'
 #' @examples
 #' \dontrun{
 #' dm_add_attribute(data.model = mydatamodel, name = "new_attribute", type = "character")
 #' dm_add_attribute(data.model = mydatamodel, name = "total", type = "numeric", default.val = 0)
 #' dm_add_attribute(data.model = mydatamodel, name = "date", type = "Date", default.fun = "Sys.Date")
-#' dm_add_attribute(data.model = mydatamodel, name = "progress", type = "integer", skip = TRUE)
-#' dm_add_attribute(data.model = mydatamodel, name = "internal", type = "logical", filter = TRUE)
+#' dm_add_attribute(data.model = mydatamodel, name = "progress", type = "integer", skip = "progress")
+#' dm_add_attribute(data.model = mydatamodel, name = "internal", type = "logical", filter = "internal")
 #' }
 
 
-dm_add_attribute <- function(data.model, name, type, default.val = NA, default.fun = NA, skip = FALSE, filter = FALSE){
-
-  cat("[dm_add_attribute] Add attribute to data model \n")
-
-  # -- Check for empty strings (data.frame would fail)
-  if(identical(default.val, ""))
-    default.val <- NA
-
-  if(identical(default.fun, ""))
-    default.fun <- NA
-
-  # -- make sure default.val & fun are mutual exclusive #230
-  # limitation: to when default.fun contains only 1 value (one attribute is added at a time)
-  if(length(default.fun) == 1 && !is.na(default.fun))
-    default.val <- NA
-
-  # -- Check for NULL
-  if(is.null(skip))
-    skip <- FALSE
+dm_add_attribute <- function(data.model, name, type,
+                             default.val = NULL, default.fun = NULL, default.arg = NULL,
+                             filter = NULL, skip = NULL,
+                             sort.rank = NULL, sort.desc = NULL){
 
-  if(is.null(filter))
-    filter <- FALSE
+  cat("[dm_add_attribute] Add attribute to data model =", name, "\n")
 
-  # -- Init attribute
-  new_attribute <- data.frame(name = name,
-                              type = type,
+  # -- Init attribute (using data_model to fit with structure)
+  new_attribute <- data_model(colClasses = stats::setNames(type, name),
                               default.val = default.val,
                               default.fun = default.fun,
+                              default.arg = default.arg,
+                              filter = filter,
                               skip = skip,
-                              filter = filter)
+                              sort.rank = sort.rank,
+                              sort.desc = sort.desc)
 
   # -- Merge to data.model (return)
   data.model <- rbind(data.model, new_attribute)