1################################################################################ 2# File: ddalpha.classify.r 3# Created by: Pavlo Mozharovskyi 4# First published: 28.02.2013 5# Last revised: 15.05.2013 6# 7# Contains the classification function of the DDalpha-classifier. 8# 9# For a description of the algorithm, see: 10# Lange, T., Mosler, K. and Mozharovskyi, P. (2012). Fast nonparametric 11# classification based on data depth. Statistical Papers. 12# Mozharovskyi, P., Mosler, K. and Lange, T. (2013). Classifying real-world 13# data with the DDalpha-procedure. Mimeo. 14################################################################################ 15 16ddalpha.classify <- function(ddalpha, 17 objects, 18 subset, 19 outsider.method = NULL, 20 use.convex = NULL){ 21 # Checks 22 if (!is.matrix(objects) && !is.data.frame(objects)){ 23 objects <- matrix(objects, nrow=1) 24 } 25 if (!(is.matrix(objects) && is.numeric(objects) 26 || is.data.frame(objects) && prod(sapply(objects, is.numeric)))){ 27 warning("Argument \"objects\" has unacceptable format. Classification can not be performed!!!") 28 return (NULL) 29 } 30 31 # convert using formula 32 if(!is.null(ddalpha$classif.formula)){ 33 objects = model.frame(ddalpha$classif.formula, data = objects) 34 } 35 36 if(!missing(subset)) 37 objects = objects[subset,] 38 39 if (ncol(objects) != ddalpha$dimension){ 40 warning("Dimension of the objects to be classified does not correspond to the dimension of the trained classifier. Classification can not be performed!!!") 41 return (NULL) 42 } 43 44 if (ddalpha$methodSeparator == "Dknn") 45 return(dknn.classify.trained(objects, ddalpha)) 46 47# if (!is.character(outsider.method) 48# || length(outsider.method) != 1){ 49# warning("Argument \"outsidet.method\" not specified correctly. Outsiders will be ignored!!!") 50# outsider.method <- NULL 51# } 52 if (is.null(use.convex)){ 53 use.convex <- ddalpha$useConvex 54 } 55 depths <- matrix(nrow=0, ncol=ddalpha$numPatterns) #? 56 freePoints <- matrix(nrow=0, ncol=ncol(objects)) #? 57 58 if (is.null(ddalpha$methodDepth)){ #use only outsiders treatment 59 classifiableIndices <- c() 60 resultsDepths <- list() 61 freePoints <- objects 62 } 63 else { 64 # Define points that can be classified by the DD-Alpha and the outsiders 65 if (use.convex){ 66 points <- ddalpha$patterns[[1]]$points 67 cardinalities <- c(ddalpha$patterns[[1]]$cardinality) 68 for (i in 2:ddalpha$numPatterns){ 69 points <- rbind(points, ddalpha$patterns[[i]]$points) 70 cardinalities <- c(cardinalities, ddalpha$patterns[[i]]$cardinality) 71 } 72 classifiable <- .are_classifiable(objects, points, cardinalities) 73 classifiableIndices <- which(classifiable == 1) 74 if (length(classifiableIndices) == 0){ 75 depths <- matrix(nrow=0, ncol=ddalpha$numPatterns) 76 freePoints <- objects 77 }else{ 78 depths <- .ddalpha.count.depths(ddalpha, objects[classifiableIndices,]) 79 80 freePoints <- matrix(objects[-classifiableIndices,,drop=F], 81 nrow=nrow(objects)-length(classifiableIndices)) 82 } 83 }else{ 84 ifelse(ddalpha$methodDepth == "ddplot", 85 depths <- objects, 86 depths <- .ddalpha.count.depths(ddalpha, objects) ) 87 88 classifiableIndices <- c() 89 for (i in 1:nrow(depths)){ 90 if (sum(depths[i,]) > 0){ 91 classifiableIndices <- c(classifiableIndices, i) 92 } 93 } 94 if (length(classifiableIndices) == 0){ 95 depths <- matrix(nrow=0, ncol=ddalpha$numPatterns) 96 freePoints <- objects 97 }else{ 98 depths <- suppressWarnings( as.matrix(depths[classifiableIndices,,drop=F], 99 nrow=length(classifiableIndices), ncol=ddalpha$numPatterns)) 100 freePoints <- # objects[-classifiableIndices,,drop=F]# 101 suppressWarnings( as.matrix(objects[-classifiableIndices,,drop=F], 102 nrow=nrow(objects)-length(classifiableIndices), 103 ncol=ncol(objects))) 104 } 105 } 106 107 # Classify with the pure DD classifiers 108 resultsDepths <- list() 109 if (nrow(depths) > 0){ 110 111 fname = paste0(".", ddalpha$methodSeparator, "_classify") 112 classify <- .getFunction(fname) 113 114 resultsDepths1 <- list() 115 if (ddalpha$methodSeparatorBinary){ 116 #### Binary classifiers 117 118 votes <- matrix(rep(0, nrow(depths)*ddalpha$numPatterns), nrow=nrow(depths), ncol=ddalpha$numPatterns) 119 for (i in 1:ddalpha$numClassifiers){ 120 xAxis <- ddalpha$classifiers[[i]]$index1 121 yAxis <- ddalpha$classifiers[[i]]$index2 122 123 result <- classify(ddalpha, ddalpha$classifiers[[i]], depths) 124 125 for (obj in 1:nrow(depths)){ 126 if (result[obj] > 0){ 127 votes[obj,xAxis] <- votes[obj,xAxis] + 1 128 }else{ 129 votes[obj,yAxis] <- votes[obj,yAxis] + 1 130 } 131 } 132 } 133 for (i in 1:nrow(depths)){ 134 resultsDepths[[i]] <- ddalpha$patterns[[which.max(votes[i,])]]$name 135 } 136 } else { 137 #### Multiclass classifiers 138 139 indexes <- classify(ddalpha, ddalpha$classifiers[[1]], depths) 140 141 for (i in 1:nrow(depths)){ 142 resultsDepths[[i]] <- ddalpha$patterns[[indexes[i]]]$name 143 } 144 } 145 146 } 147 } # end if(!is.null(ddalpha$methodDepth)) 148 149 # Classify Outsiders 150 resultsOutsiders <- as.list(rep("Ignored", nrow(freePoints))) 151 freePoints 152 if (is.null(outsider.method) && length(ddalpha$methodsOutsider) == 1) 153 outsider.method = ddalpha$methodsOutsider[[1]]$name 154 if (length(resultsOutsiders) > 0 && !is.null(outsider.method)){ 155 for (i in 1:length(ddalpha$methodsOutsider)){ 156 if (toupper(ddalpha$methodsOutsider[[i]]$name) == toupper(outsider.method)){ 157 resultsOutsiders <- .ddalpha.classify.outsiders(freePoints, ddalpha, ddalpha$methodsOutsider[[i]]) 158 break 159 } 160 } 161 } 162 163 # Merge classifiable and outsiders 164 if (length(resultsOutsiders) == 0) 165 results <- resultsDepths 166 else if(length(resultsDepths) == 0) 167 results <- resultsOutsiders 168 else{ 169 170 if(is.factor(resultsOutsiders[[1]]) && !is.factor(resultsDepths[[1]])) 171 resultsOutsiders = lapply(resultsOutsiders, as.character) 172 173 if(is.numeric(resultsDepths[[1]]) && !is.numeric(resultsOutsiders[[1]])) 174 resultsOutsiders = as.numeric(resultsOutsiders) 175 176 results <- list() 177 counterDepths <- 1 178 counterOutsiders <- 1 179 for (i in 1:nrow(objects)){ 180 if (i %in% classifiableIndices){ 181 results[[i]] <- resultsDepths[[counterDepths]] 182 counterDepths <- counterDepths + 1 183 }else{ 184 results[[i]] <- resultsOutsiders[[counterOutsiders]] 185 counterOutsiders <- counterOutsiders + 1 186 } 187 } 188 } 189 190 if (length(results) == 1) return(results[[1]]) 191 else return (results) 192} 193 194predict.ddalpha <- function(object, 195 objects, 196 subset, 197 outsider.method = NULL, 198 use.convex = NULL, ...){ 199 return(ddalpha.classify(object, objects, subset, outsider.method, use.convex)) 200} 201