R/tdmGeneralUtils.r

Defines functions tdmBindResponse cat1 cat2 print1 print2 predict.TDMenvir predict.TDMclassifier predict.TDMregressor Opts Opts.TDMenvir Opts.TDMclassifier Opts.TDMregressor Opts.tdmClass Opts.tdmRegre Opts.default RGainTST RGainTRN SRF

Documented in cat1 cat2 Opts Opts.default Opts.tdmClass Opts.TDMclassifier Opts.TDMenvir Opts.tdmRegre Opts.TDMregressor predict.TDMclassifier predict.TDMenvir predict.TDMregressor print1 print2 tdmBindResponse

######################################################################################
######################################################################################
# Package Description for Roxygene:
#' Tuned Data Mining in R
#'
#' \tabular{ll}{
#' Package: \tab TDMR\cr
#' Type: \tab Package\cr
#' Version: \tab 2.2\cr
#' Date: \tab 01.03.2020\cr
#' License: \tab GPL (>= 2)\cr
#' LazyLoad: \tab yes\cr
#' }
#'
#' TDMR is a package for tuned data mining (predictive analytics, i.e. \bold{classification} and \bold{regression}). Its main features are: \cr
#' 1) A variety of tuners, with special emphasis on \link{SPOT} (a well-known R package for parameter tuning), but also CMA-ES 
#'    (package \code{\link[rCMA]{rCMA-package}}) and other tuning algorithms. \cr
#' 2) Tuning of preprocessing parameters and model building parameters simultaneously. Preprocessing
#' often includes feature generation. \cr
#' 3) Support for multiple tuning experiments (different settings, repetitions with different resamplings, ...).  \cr
#' 4) Easy parallelization of those experiments with the help of R package \code{\link{parallel}}.  \cr
#' 5) Extensibility: New tuning parameters, new preprocessing tools, model builders and even new tuners can be added easily.
#' 
#' The main entry point functions are \code{\link{tdmClassifyLoop}}, \code{\link{tdmRegressLoop}},
#' \code{\link{tdmTuneIt}}, and \code{\link{tdmBigLoop}}. 
#' See \code{\link{tdmOptsDefaultsSet}} and \code{\link{tdmDefaultsFill}} for an overview of adjustable TDMR-parameters.
#'                                                
#' @name TDMR-package
#' @aliases TDMR
#' @docType package
#' @title Tuned Data Mining in R
#' @author Wolfgang Konen (\email{wolfgang.konen@@th-koeln.de}), Patrick Koch
#' @references \url{http://lwibs01.gm.fh-koeln.de/blogs/ciop/research/tuned-data-mining/}
#' @keywords package tuning data mining machine learning
#' @import SPOT 
#' @import twiddler 
#' @import testit
#' @import tcltk
#' @importFrom "grDevices" "colors" "dev.cur" "dev.list" "dev.new" "dev.off" "graphics.off" "pdf" "png"
#' @importFrom "graphics" "barplot" "legend" "pairs" "par" "plot" "points" "title"
#' @importFrom "stats" "embed" "formula" "lm" "median.default" "optim" "prcomp" "predict" "rnorm" "runif" "sd"
#' @importFrom "utils" "flush.console" "head" "read.csv" "read.table" "tail" "write.table"
#### @import adabag
#### no longer needed:  @import e1071     (because e1071 moved from "Depends" to "Suggests" in DESCRIPTION)


#End of Package Description
NA #NULL, ends description without hiding first function
######################################################################################
######################################################################################



######################################################################################
#
# GENERAL UTILITY FUNCTIONS
#
######################################################################################
######################################################################################

######################################################################################
#' Bind a column to a data frame. 
#'
#' Bind the column with name \code{response.predict} and 
#' contents \code{vec} as last column to data frame \code{d}
#' @param d data frame
#' @param response.predict name of new column 
#' @param vec the contents for the last column bound to data frame \code{d}
#' @return data frame \code{d} with column added
#' @export
######################################################################################
tdmBindResponse <- function(d,response.predict,vec)
{
    if (is.na(match(response.predict,names(d)))) {
      # bind column response.predict as last column to data frame d
      eval(parse(text=paste("d <- cbind(d, ",response.predict,"=vec)")))
    } else {
      # replace contents of existing column response.predict
      d[,response.predict] <- vec;
    }

    return(d)
}

######################################################################################
# printout functions for different verbosity levels
######################################################################################
#' Output objects to \code{cat} if \code{opts$VERBOSE>=1}.
#'
#' @param opts from which we need the element VERBOSE
#' @param ...  objects
#' @return None
#' @seealso   \code{\link{cat}}
#' @export
#' @keywords internal
cat1 <- function(opts, ...) {  if (opts$VERBOSE>=1) cat(...); }
######################################################################################
#' Output objects to \code{cat} if \code{opts$VERBOSE>=2}.
#'
#' @param opts from which we need the element VERBOSE
#' @param ...  objects
#' @return None
#' @seealso   \code{\link{cat}}
#' @export
#' @keywords internal
cat2 <- function(opts, ...) {  if (opts$VERBOSE>=2) cat(...); }

######################################################################################
#' Print objects using \code{print} if \code{opts$VERBOSE>=1}.
#'
#' @param opts from which we need the element VERBOSE
#' @param ...  objects
#' @return None
#' @seealso   \code{\link{print}}
#' @export
#' @keywords internal
print1 <- function(opts, ...) {  if (opts$VERBOSE>=1) print(...); }

######################################################################################
#' Print objects using \code{print} if \code{opts$VERBOSE>=2}.
#'
#' @param opts from which we need the element VERBOSE
#' @param ...  objects
#' @return None
#' @seealso   \code{\link{print}}
#' @export
#' @keywords internal
print2 <- function(opts, ...) {  if (opts$VERBOSE>=2) print(...); }


######################################################################################
#
# UTILITY FUNCTIONS FOR TDMenvir, TDMclassifier AND TDMregressor OBJECTS
#
######################################################################################
######################################################################################

######################################################################################
#' Make a prediction using the last model.
#'
#' Make a prediction with objects of class \code{\link{TDMenvir}}, \code{\link{TDMclassifier}},
#' \code{\link{TDMregressor}}. The prediction is based on the (last) model trained during 
#' \code{\link{unbiasedRun}}.
#'
#' @param object  an object of class \code{\link{TDMenvir}}, \code{\link{TDMclassifier}},
#'    \code{\link{TDMregressor}} containing in element \code{lastModel} the relevant model.
#' @param ... arguments passed on to the model's predict function. Usually the first argument of \code{...} should be 
#'      \code{newdata}, a data frame for which new predictions are desired.
#' @return a vector with length \code{nrow(newdata)} containing the new predictions.
#' @method predict TDMenvir
#' @examples
#'    \dontrun{
#'    ## This example requires that demo04cpu.r is executed first (it will write demo04cpu.RData)
#'    path <- paste(find.package("TDMR"), "demo01cpu/",sep="/");
#'    tdm <- list(  filenameEnvT="demo04cpu.RData" );   # file with environment envT 
#'    load(paste(path,tdm$filenameEnvT,sep="/"));
#'               
#'    # take only the first 15 records:
#'    newdata=read.csv2(file=paste(path,"data/cpu.csv", sep=""), dec=".")[1:15,];     
#'    z=predict(envT,newdata);
#'    print(z);
#'    }
#' @export
predict.TDMenvir <- function(object,...) {
  if (is.null(object$result)) stop("TDMenvir has no element 'result'");
  if (is.null(object$result$lastRes)) stop("TDMenvir has no element 'result$lastRes'");
  if (is.null(object$result$lastRes$lastModel)) stop("TDMenvir has no element 'result$lastRes$lastModel'. Consider to set tdm$U.saveModel=TRUE.");
  predict(object$result$lastRes$lastModel,...);
}
######################################################################################
#' @rdname predict.TDMenvir
#' @method predict TDMclassifier
#' @export
# @keywords internal
predict.TDMclassifier <- function(object,...) {
  predict(object$lastRes$lastModel,...);
}
######################################################################################
#' @rdname predict.TDMenvir
#' @method predict TDMregressor
#' @export
predict.TDMregressor <- function(object,...) {
  predict(object$lastRes$lastModel,...);
}


######################################################################################
#' Return the list 'opts'.
#'
#' Returns the list \code{opts} from objects of class \code{\link{TDMenvir}}, \code{\link{TDMclassifier}},
#'                  \code{\link{TDMregressor}}, \code{\link[=tdmClassify]{tdmClass}} or \code{\link[=tdmRegress]{tdmRegre}}.
#' @param x  an object of class \code{\link{TDMenvir}}, \code{\link{TDMclassifier}}, \code{\link[=tdmClassify]{tdmClass}}, 
#'                                \code{\link{TDMregressor}} or \code{\link[=tdmRegress]{tdmRegre}}.
#' @param ... -- currently not used -- 
#' @return the list \code{opts} with DM-specific settings contained in the specified object
#' @export
Opts <- function(x, ...)  UseMethod("Opts");

######################################################################################
#' @rdname Opts
#' @method Opts TDMenvir
#' @export
# @keywords internal
Opts.TDMenvir  <- function(x, ...) {
  if (is.null(x$result)) stop("TDMenvir has no element 'result'");
  if (is.null(x$result$lastRes)) stop("TDMenvir has no element 'result$lastRes'");
  x$result$lastRes$opts;
}
######################################################################################
#' @rdname Opts
#' @method Opts TDMclassifier
#' @export
# @keywords internal
Opts.TDMclassifier  <- function(x, ...) x$lastRes$opts;
#' @rdname Opts
#' @method Opts TDMregressor
#' @export
# @keywords internal
Opts.TDMregressor  <- function(x, ...) x$lastRes$opts;
#' @rdname Opts
#' @method Opts tdmClass
#' @export
# @keywords internal
Opts.tdmClass <- function(x,...) x$opts;
#' @rdname Opts
#' @method Opts tdmRegre
#' @export
# @keywords internal
Opts.tdmRegre <- function(x,...) x$opts;
#' @rdname Opts
#' @method Opts default
#' @export
# @keywords internal
Opts.default <- function(x, ...)  cat("This is Opts.default\n");

######################################################################################

#summary.TDMclassifier <- function(result,...) {
#  cat("This is the TDMclassifier summary\n");
#}


RGainTST <- function(result) {
  if (!inherits(result, "TDMclassifier"))
        stop("This function is permitted only for objects of class `TDMclassifier'");
  mean(result$R_vali);
}

RGainTRN <- function(result) {
  if (!inherits(result, "TDMclassifier"))
        stop("This function is permitted only for objects of class `TDMclassifier'");
  mean(result$R_train);
}

SRF <- function(result) {
  if (!inherits(result, "TDMclassifier"))
        stop("This function is permitted only for objects of class `TDMclassifier'");
  result$lastRes$SRF;
}

Try the TDMR package in your browser

Any scripts or data that you put into this service are public.

TDMR documentation built on March 3, 2020, 1:06 a.m.