Cacher is the code snippet organizer for pro developers

#' Apply cutoff in CV
#' 
#' Apply a cutoff learned on a cross-validated model (from cv.learn.fun)
#'
#' @param CVmodel 
#' Model from cv.learn.fun
#' @param CVcutoffs 
#' Cutoffs from cv.learn.cutoff
#' @param cutoff.whichdata 
#' The cutoff on which data it was learned
#' @param whichdata 
#' On which data from CVmodel should the cutoffs be applied?
#' @param cutofflabels 
#' How are the cutoffs named? (For 2 cutoffs: low, mid, high)
#' It happens that in one step two cutoffs have the same value.
#' The samples are then parted into "low" and "high"
#' @param reference.cutofflabel 
#' The cutoff-label "in the middle" (For 2 cutoffs: mid)
#' @param newname 
#' How should the new column be named which is concatenated to CVmodel
#' @return
#' @export
#'
#' @examples
cv.apply.cutoff <- function(CVmodel
							,CVcutoffs
							,cutoff.whichdata = "trainResponseScaled"
							,whichdata = "testResponseScaled"
							,cutofflabels = c("low", "mid", "high")
							,reference.cutofflabel = "mid"
							,newname="testResponseScaledGroups"){
	if(any(names(CVmodel) != names(CVcutoffs[[cutoff.whichdata]]))){
		stop("Names from CVmodel and CVcutoffs[[cutoff.whichdata]] are not equal")
	}
	cutoffs <- CVcutoffs[[cutoff.whichdata]]
	for(CVstepX in names(CVmodel)){
		tmp.cutoffs <- cutoffs[[CVstepX]]$cutoff
		tmp.data <- CVmodel[[CVstepX]][[whichdata]]
		if(all(is.na(tmp.cutoffs))){
			tmp.data[] <- NA
			CVmodel[[CVstepX]][[newname]] <- tmp.data
			next
		}
		tmp.cutoff.ranges <- c(-Inf, sort(unique(tmp.cutoffs)), Inf)
		tmp.cutofflabels <- cutofflabels
		if(length(tmp.cutoff.ranges)  < (length(tmp.cutoffs) + 2)){
			tmp.cutofflabels <- cutofflabels[c(1:(length(tmp.cutoff.ranges)-2), length(cutofflabels))]
		}
		if(!is.null(tmp.data)){
			tmp.testgroups <- cut( tmp.data, tmp.cutoff.ranges, labels = tmp.cutofflabels)
			if(!(length(tmp.cutoff.ranges)  < (length(tmp.cutoffs) + 2))){
				tmp.testgroups <- relevel(tmp.testgroups, ref = reference.cutofflabel)
			}
			names(tmp.testgroups) <- names(tmp.data)
		}else{
			tmp.testgroups <- NULL
		}
		CVmodel[[CVstepX]][[newname]] <- tmp.testgroups
	}
	return(CVmodel)
}