Commit bb153581 authored by Edi Prifti's avatar Edi Prifti

- add plot to computeIntercept

- fix doc
parent 9aae91a8
......@@ -1214,9 +1214,10 @@ evaluateFit <- function(mod, X, y, clf, force.re.evaluation = FALSE, mode = "tra
#' @param verbose: print running information when set to TRUE
#' @param sign: weather the score should be greater or smaller than the intercept (default:"auto")
#' @param return.all: if TRUE, the function will return the intercept as well as the table used to compute it.
#' @param plot: if TRUE, the score will be visialized (default:FALSE)
#' @return the intercept, the sign and the accuracy
#' @export
computeIntercept <- function(score, y, verbose=FALSE, sign="auto") {
computeIntercept <- function(score, y, verbose=FALSE, sign="auto", plot = FALSE) {
# make vectors of 0/1 to identify positive labels and negative labels
if(!is.factor(y))
......@@ -1273,12 +1274,7 @@ computeIntercept <- function(score, y, verbose=FALSE, sign="auto") {
m.raw <- data.frame(score, PosClass, NegClass) # combine them in a frame
m.raw <- m.raw[order(m.raw$score),] # sort the frame by increasing scores, and rearrange
m <- m.raw
# plot(m$score)
# points(which(m$PosClass==1),m$score[m$PosClass==1], col="red", pch="*")
# points(which(m$NegClass==1),m$score[m$NegClass==1], col="skyblue", pch="*")
# if(length(unique(m.raw$score)) != length(m.raw$score)) # if multiple values to be aggregated
# {
# m <- aggregate(x = m.raw, by = list(m.raw$score), FUN = "sum")
......@@ -1323,7 +1319,23 @@ computeIntercept <- function(score, y, verbose=FALSE, sign="auto") {
#abline(v=min.err.ind, lty = 2, col = "blue")
res <- list(intercept = intercept,
sign = sign,
accuracy = (1-(min(m[,"ERR"])/length(y))) )
accuracy = (1-(min(m[,"ERR"])/length(y)))
)
if(plot)
{
par(mfrow=c(2,1))
# plot score
plot(m$score, cex = 1, col = 'white', ylab = "model score", xlab = "observations ordered by score")
points(which(m$PosClass==1),m$score[m$PosClass==1], col="firebrick", pch="*", cex = 2)
points(which(m$NegClass==1),m$score[m$NegClass==1], col="darkblue", pch="*", cex = 2)
abline(h = intercept, col = "red", lty = 2)
# plot error
plot(m$ERR, cex = 1, col = 'black', pch = 19, ylab = "cumulative error", xlab = "observations ordered by score")
abline(v = min.err.ind, col = "red", lty = 2)
par(mfrow=c(1,1))
}
return(res)
}
......@@ -6082,7 +6094,7 @@ mergeMeltBestScoreCV <- function(list.results.digest, k_catalogue = NULL, score=
#'
#' @title mergeResults
#' @description mergeResults returns a list of data frames that contain the performance of each digest in the list with their sparsity.
#' @param list.digest: a list of digest objects one for each learner used. For example, list(res.terda.digest, res.terga.digest, res.terbeam.digest)
#' @param list.results: a list of Experiment objects one for each learner used. For example, list(res.terda, res.terga, res.terbeam)
#' @param sparsity: Sometimes a given method will have results with somehow different sparsity. This param will allow to set the catalogue of sparsity
#' @param best.k: a vector defining wether a given k should be used to set the best model selection (default:NULL).
#' @param colors: a vector defining the colors to be used in the graphics. If not specified they will be set by default. (default:NULL).
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment