R/ddalpha.test.r

Defines functions ddalpha.getErrorRatePart ddalpha.getErrorRateCV ddalpha.test

Documented in ddalpha.getErrorRateCV ddalpha.getErrorRatePart ddalpha.test

ddalpha.test <- function(learn, test, ...){
  ops <- options(warn = -1)
  on.exit(options(ops))
  
  if(is.vector(test))
    test = t(as.matrix(test))
  
  tryCatch({
    time <- system.time(
      ddalpha <- ddalpha.train(learn, ...)
    )
    C = ddalpha$dimension+1
    cc = ddalpha.classify(objects = test[,-C], ddalpha = ddalpha)
    if (is.numeric(test[,C])){
      if(is.factor(cc[[1]]) || is.character(cc[[1]])){
        cc <- unlist(lapply(cc, as.character))
        cc[cc == "Ignored"] <- NA
      }
      equal = (cc == test[,C])
    } else {
      cc <- unlist(lapply(cc, as.numeric)) 
      equal = (cc == as.numeric(test[,C]))      
    }
    
    if(!(T %in% equal) && !(F %in% equal)) 
    { return(NA)}
    error = sum(!equal,na.rm = T)/(sum(!equal,na.rm = T)+sum(equal,na.rm = T))
    return(list(error = error, correct = sum(equal,na.rm = T), incorrect = sum(!equal,na.rm = T), 
                total = length(cc)-sum(is.na(equal)), ignored = sum(is.na(equal)), n = length(cc),
                time = time[1])) 
  }
  #  tryCatch({}
  , error = function(e) {
    print ("ERROR T")
    print (e)
  }, finally = {          
  })
  return (NA)
}


ddalpha.getErrorRateCV <- function(data, numchunks = 10,  ...){
  n = nrow(data)
  numchunks = min(n, numchunks)
  chunksize = ceiling(n/numchunks)
  
  sample = seq(from = 1, by = numchunks, length.out = chunksize)   
  
  errors = 0
  total = 0
  times = c()
  
  for (i in 1:numchunks){
    sample = sample[sample<=n]
    learn = data[-sample,,drop = F]
    test  = data[sample,,drop = F]
    
    el = ddalpha.test(learn, test, ...)
    if(is.list(el)){
      errors = errors + el$incorrect
      total = total + el$total
      times = c(times,el$time)
    }
    
    sample = sample+1
  }
  
  return (list(errors = errors/total, time = mean(times), time_sd = sd(times)))  
}


ddalpha.getErrorRatePart <- function(data, size = 0.3, times = 10,  ...){
  
  if (!is.numeric(size) || size <=0 || size >= nrow(data)) stop("Wrong size of excluded sequences")
  
  if(size < 1)
    size = max(1, size*nrow(data)) # at least 1 point
  
  size = as.integer(size)
  
  indexes = 1:nrow(data)
  
  errors = c()
  total = 0
  time = c()
  
  for (i in 1:times){
    samp = sample(indexes, size)
    learn = data[-samp,,drop = F]
    test  = data[samp,,drop = F]
    
    el = ddalpha.test(learn, test, ...)
    if(is.list(el)){
      errors = c(errors,el$incorrect/el$total)
      time = c(time,el$time)
    }
  }
  
  return (list(errors = mean(errors), errors_sd = sd(errors), errors_vec = errors, time = mean(time), time_sd = sd(time)))  
}

Try the ddalpha package in your browser

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

ddalpha documentation built on March 23, 2022, 9:07 a.m.