massdataset: massdataset

# #' @title add_column
# #' @description add_column. This function is from tibble.
# #' @author Xiaotao Shen
# #' \email{shenxt1990@@outlook.com}
# #' @importFrom tibble add_column
# #' @include mass_dataset_class.R
# #' @param .data mass_data class
# #' @param ... dynamic-dots Name-value pairs, passed on to tibble().
# #' All values must have the same size of .data or size 1.
# #' @param .before One-based column index or column name where to add
# #' the new columns, default: after last column.
# #' @param .after One-based column index or column name where to add
# #' the new columns, default: after last column.
# #' @param .name_repair Treatment of problematic column names:
# #' "minimal": No name repair or checks, beyond basic existence,
# #' "unique": Make sure names are unique and not empty,
# #' "check_unique": (default value), no name repair, but check they are unique,
# #' "universal": Make the names unique and syntactic
# #' a function: apply custom name repair (e.g., .name_repair = make.names for
# #' names in the style of base R).
# #' A purrr-style anonymous function, see rlang::as_function()
# #' This argument is passed on as repair to vctrs::vec_as_names().
# #' See there for more details on these terms and the strategies
# #' used to enforce them.
# #' @return A mass_dataset class object
# #' @export
# 
# setGeneric(name = "add_column")
# 
# #' @title add_column
# #' @method add_column mass_dataset
# #' @param .data mass_data class
# #' @param ... dynamic-dots Name-value pairs, passed on to tibble().
# #' All values must have the same size of .data or size 1.
# #' @param .before One-based column index or column name where to add
# #' the new columns, default: after last column.
# #' @param .after One-based column index or column name where to add
# #' the new columns, default: after last column.
# #' @param .name_repair Treatment of problematic column names:
# #' "minimal": No name repair or checks, beyond basic existence,
# #' "unique": Make sure names are unique and not empty,
# #' "check_unique": (default value), no name repair, but check they are unique,
# #' "universal": Make the names unique and syntactic
# #' a function: apply custom name repair (e.g., .name_repair = make.names for
# #' names in the style of base R).
# #' A purrr-style anonymous function, see rlang::as_function()
# #' This argument is passed on as repair to vctrs::vec_as_names().
# #' See there for more details on these terms and the strategies
# #' used to enforce them.
# #' @include mass_dataset_class.R
# #' @export
# #' @return mass_dataset class
# 
# setMethod(f = "add_column",
#           signature("mass_dataset"),
#           function(.data,
#                    ...,
#                    .before = NULL,
#                    .after = NULL,
#                    .name_repair = c("check_unique",
#                                     "unique",
#                                     "universal",
#                                     "minimal")) {
#             .name_repair <- match.arg(.name_repair)
#             if (length(.data@activated) == 0) {
#               stop("activate you object using activate_mass_dataset first.\n")
#             }
# 
#             if (!.data@activated %in% c("expression_data",
#                                         "sample_info",
#                                         "variable_info")) {
#               stop("activate should be one of 'expression_data',
#                    'sample_info' and 'variable_info'")
#             }
# 
#             temp_slot <-
#               slot(object = .data, name = .data@activated)
# 
#             dots <- rlang::quos(...)
# 
#             temp_slot <-
#               tibble::add_column(
#                 temp_slot,
#                 !!!dots,
#                 .before = .before,
#                 .after = .after,
#                 .name_repair = .name_repair
#               )
# 
#             slot(object = .data, name = .data@activated) <-
#               temp_slot
# 
#             if (.data@activated == "expression_data") {
#               new_sample_id =
#                 setdiff(colnames(temp_slot), .data@sample_info$sample_id)
#               if (length(new_sample_id) > 0) {
#                 new_sample_info =
#                   matrix(ncol = ncol(.data@sample_info),
#                          nrow = length(new_sample_id)) %>%
#                   as.data.frame()
#                 colnames(new_sample_info) = colnames(.data@sample_info)
#                 new_sample_info$sample_id = new_sample_id
#                 .data@sample_info =
#                   rbind(.data@sample_info,
#                         new_sample_info)
#                 .data@expression_data <-
#                   .data@expression_data[, .data@sample_info$sample_id, drop = FALSE]
#               }
#             }
# 
#             if (.data@activated == "sample_info") {
#               if (ncol(temp_slot) > nrow(.data@sample_info_note)) {
#                 new_sample_info_note =
#                   data.frame(
#                     name = setdiff(colnames(temp_slot), .data@sample_info_note$name),
#                     meaning = setdiff(colnames(temp_slot), .data@sample_info_note$name),
#                     check.names = FALSE
#                   )
#                 .data@sample_info_note <-
#                   rbind(.data@sample_info_note,
#                         new_sample_info_note)
#                 .data@sample_info <-
#                   .data@sample_info[, .data@sample_info_note$name, drop = FALSE]
#               }
#             }
# 
#             if (.data@activated == "variable_info") {
#               if (ncol(temp_slot) > nrow(.data@variable_info_note)) {
#                 new_variable_info_note =
#                   data.frame(
#                     name = setdiff(colnames(temp_slot), .data@variable_info_note$name),
#                     meaning = setdiff(colnames(temp_slot), .data@variable_info_note$name),
#                     check.names = FALSE
#                   )
#                 .data@variable_info_note =
#                   rbind(.data@variable_info_note,
#                         new_variable_info_note)
#                 .data@variable_info <-
#                   .data@variable_info[, .data@variable_info_note$name, drop = FALSE]
#               }
#             }
# 
# 
#             process_info <- .data@process_info
# 
#             internal_parameter <-
#               purrr::map2(names(dots), dots, function(x, y) {
#                 y = rlang::expr_label(y)
#                 y = stringr::str_replace_all(y, "\\`", "") %>%
#                   stringr::str_replace("\\~", "")
#                 paste(x, y, sep = '=')
#               })
#             names(internal_parameter) <- "dots"
#             parameter <- new(
#               Class = "tidymass_parameter",
#               pacakge_name = "massdataset",
#               function_name = "mutate()",
#               parameter = c(
#                 internal_parameter,
#                 .before = .before,
#                 .after = .after,
#                 .name_repair = .name_repair
#               ),
#               time = Sys.time()
#             )
# 
#             if (all(names(process_info) != "add_column")) {
#               process_info$add_column = parameter
#             } else{
#               process_info$add_column = c(process_info$add_column, parameter)
#             }
# 
#             .data@process_info <- process_info
# 
#             return(.data)
#           })