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