R/evaluate.R

In mhahsler/recommenderlab: Lab for Developing and Testing Recommender Algorithms

setMethod("evaluate", signature(x = "evaluationScheme", method = "character"),
  function(x,
    method,
    type = "topNList",
    n = 1:10,
    parameter = NULL,
    progress = TRUE,
    keepModel = FALSE) {
    scheme <- x
    runs <- 1:scheme@k

    if (progress)
      cat(method, "run fold/sample [model time/prediction time]")

    cm <- list()
    for (r in runs) {
      if (progress)
        cat("\n\t", r, " ")

      cm[[r]] <- .do_run_by_n(
        scheme,
        method,
        run = r,
        type = type,
        n = n,
        parameter = parameter,
        progress = progress,
        keepModel = keepModel
      )
    }

    if (progress)
      cat("\n")

    new(
      "evaluationResults",
      results = cm,
      method = recommenderRegistry$get_entry(method)$method
    )
  })

setMethod("evaluate", signature(x = "evaluationScheme", method = "list"),
  function(x,
    method,
    type = "topNList",
    n = 1:10,
    parameter = NULL,
    progress = TRUE,
    keepModel = FALSE) {
    ## method is a list of lists
    #list(RANDOM = list(name = "RANDOM", parameter = NULL),
    #	POPULAR = list(...

    results <- lapply(
      method,
      FUN = function(a)
        try(evaluate(
          x,
          a$n,
          n = n ,
          type = type,
          parameter = a$p,
          progress = progress,
          keepModel = keepModel
        ))
    )

    ## handle recommenders that have failed
    errs <- sapply(results, is, "try-error")
    if (any(errs))
    {
      warning(
        paste(
          "\n  Recommender '",
          names(results)[errs],
          "' has failed and has been removed from the results!",
          sep  =  ''
        )
      )
      results[errs] <- NULL
    }

    as(results, "evaluationResultList")
  })


## evaluation work horse
.do_run_by_n <-
  function(scheme,
    method,
    run,
    type,
    n,
    parameter = NULL,
    progress = FALSE,
    keepModel = TRUE) {
    ## prepare data
    train <- getData(scheme, type = "train", run = run)
    test_known <- getData(scheme, type = "known", run = run)
    test_unknown <- getData(scheme, type = "unknown", run = run)
    given <- getData(scheme, type = "given", run = run)

    ## train recommender
    time_model <- system.time(rec <-
        Recommender(train, method, parameter = parameter),
      gcFirst = FALSE)


    time_predict <- system.time(pre <-
        predict(rec, test_known, n = max(n), type = type),
      gcFirst = FALSE)

    if (is(pre, "topNList")) {
      res <- NULL
      for (i in 1:length(n)) {
        NN <- n[i]

        ## get best N
        topN <- bestN(pre, NN)

        r <-  calcPredictionAccuracy(
          topN,
          test_unknown,
          byUser = FALSE,
          given = given,
          goodRating = scheme@goodRating
        )
        res <- rbind(res, r)
      }
      res <- cbind(res, n)

    } else{
      res <- calcPredictionAccuracy(
        pre,
        test_unknown,
        byUser = FALSE,
        given = given,
        goodRating = scheme@goodRating
      )

      res <- rbind(res)
    }

    rownames(res) <- NULL

    time_usage <- function(x)
      x[1] + x[2]

    if (progress)
      cat("[",
        time_usage(time_model),
        "sec/",
        time_usage(time_predict),
        "sec] ",
        sep = "")

    new("confusionMatrix",
      cm = res,
      model =
        if (keepModel)
          rec
      else
        NULL)
  }