[Zooimage-commits] r72 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 15 13:51:37 CEST 2009
Author: romain
Date: 2009-04-15 13:51:37 +0200 (Wed, 15 Apr 2009)
New Revision: 72
Removed:
pkg/zooimage/R/_garbage.R
Modified:
pkg/zooimage/R/ZIClass.r
Log:
using rowSums/colSums where appropriate
Modified: pkg/zooimage/R/ZIClass.r
===================================================================
--- pkg/zooimage/R/ZIClass.r 2009-04-15 11:46:38 UTC (rev 71)
+++ pkg/zooimage/R/ZIClass.r 2009-04-15 11:51:37 UTC (rev 72)
@@ -224,34 +224,37 @@
nX <- nrow(confmat)
nY <- ncol(confmat)
nZ <- nX*nY
-
confmat <- pmin( confmat, maxval )
- library(RColorBrewer)
+ require(RColorBrewer)
mypalette <- brewer.pal(maxval-1, "Spectral")
- #hc <- c("#FFFFFF", rev(heat.colors(maxval)))
library(gregmisc)
- heatmap.2(confmat, col= c(0,mypalette), symm=TRUE, margin=margin, trace="both", Rowv=Rowv,
- Colv=Colv, cexRow=0.2 + 1/log10(nX), cexCol=0.2 + 1/log10(nY),tracecol="Black", linecol=FALSE)
+ heatmap.2(confmat, col= c(0,mypalette), symm=TRUE, margin=margin,
+ trace="both", Rowv=Rowv, Colv=Colv, cexRow=0.2 + 1/log10(nX),
+ cexCol=0.2 + 1/log10(nY),tracecol="Black", linecol=FALSE)
}
# }}}
# New function v 1.2-2 false positive and negative
confusion.bar <- function(confmat, mar=NULL) {
- if (is.matrix(confmat) == FALSE)
- stop("object must be a matrix")
+ if (is.matrix(confmat) == FALSE){
+ stop("object must be a matrix")
+ }
Nn <- nrow(confmat)
+
## percent of correctly predicted objects in the test set
- pred.tok = diag(confmat)/apply(confmat, 2, sum)*100; pred.tok
+ pred.tok <- diag(confmat) / colSums(confmat)*100
+
# If there are no items good recognize 0/0 = NaN so replace NaN by 0 for calculation
- if (NaN %in% pred.tok){
- pred.tok[pred.tok == "NaN"] <- 0
- }
- # percent of items in the test set predicted in its category
- pred.tfrac = diag(confmat)/apply(confmat, 1, sum)*100; pred.tfrac
+ if (NaN %in% pred.tok){
+ pred.tok[pred.tok == "NaN"] <- 0
+ }
+
+ # percent of items in the test set predicted in its category
+ pred.tfrac <- diag(confmat) / rowSums(confmat)*100
if (NaN %in% pred.tfrac){
- pred.tfrac[pred.tfrac == "NaN"] <- 0
- }
+ pred.tfrac[pred.tfrac == "NaN"] <- 0
+ }
prediction <- cbind(pred.tok, pred.tfrac)
prediction.df <- data.frame(prediction)
CR <- prediction[1:Nn,2] #
Deleted: pkg/zooimage/R/_garbage.R
===================================================================
--- pkg/zooimage/R/_garbage.R 2009-04-15 11:46:38 UTC (rev 71)
+++ pkg/zooimage/R/_garbage.R 2009-04-15 11:51:37 UTC (rev 72)
@@ -1,84 +0,0 @@
-
-# withCallingHandlers <- function (expr, ..., handlers = list(...) ) {
-# classes <- names(handlers)
-# parentenv <- parent.frame()
-# if (length(classes) != length(handlers))
-# stop("bad handler specification")
-# .Internal(.addCondHands(classes, handlers, parentenv, NULL,
-# TRUE))
-# expr
-# }
-#
-# withRestarts <- function (expr, ..., restarts = list(...) ) {
-# docall <- function(fun, args) {
-# enquote <- function(x) as.call(list(as.name("quote"),
-# x))
-# if ((is.character(fun) && length(fun) == 1L) || is.name(fun))
-# fun <- get(as.character(fun), envir = parent.frame(),
-# mode = "function")
-# do.call("fun", lapply(args, enquote))
-# }
-# makeRestart <- function(name = "", handler = function(...) NULL,
-# description = "", test = function(c) TRUE, interactive = NULL) {
-# structure(list(name = name, exit = NULL, handler = handler,
-# description = description, test = test, interactive = interactive),
-# class = "restart")
-# }
-# makeRestartList <- function(..., specs = list(...)) {
-# names <- names(specs)
-# restarts <- vector("list", length(specs))
-# for (i in seq_along(specs)) {
-# spec <- specs[[i]]
-# name <- names[i]
-# if (is.function(spec))
-# restarts[[i]] <- makeRestart(handler = spec)
-# else if (is.character(spec))
-# restarts[[i]] <- makeRestart(description = spec)
-# else if (is.list(spec))
-# restarts[[i]] <- docall("makeRestart", spec)
-# else stop("not a valid restart specification")
-# restarts[[i]]$name <- name
-# }
-# restarts
-# }
-# withOneRestart <- function(expr, restart) {
-# doWithOneRestart <- function(expr, restart) {
-# restart$exit <- environment()
-# .Internal(.addRestart(restart))
-# expr
-# }
-# restartArgs <- doWithOneRestart(return(expr), restart)
-# docall(restart$handler, restartArgs)
-# }
-# withRestartList <- function(expr, restarts) {
-# nr <- length(restarts)
-# if (nr > 1L)
-# withOneRestart(withRestartList(expr, restarts[-nr]),
-# restarts[[nr]])
-# else if (nr == 1L)
-# withOneRestart(expr, restarts[[1L]])
-# else expr
-# }
-# restarts <- makeRestartList(specs = restarts)
-# if (length(restarts) == 0L)
-# expr
-# else if (length(restarts) == 1L)
-# withOneRestart(expr, restarts[[1L]])
-# else withRestartList(expr, restarts)
-# }
-#
-#
-#
-# zooImageTry <- function( expr, ... ){
-# dots <- list( ... )
-# env <- parent.frame()
-# restarts <- dots[ regexpr( "^r\\.", names(dots) ) > -1 ]
-# handlers <- dots[ regexpr( "^h\\.", names(dots) ) > -1 ]
-# env[[".handlers"]] <- handlers
-# env[[".restarts"]] <- restarts
-# env[[".expr"]] <- expression( expr )
-# evalq( withRestarts( withCallingHandlers( eval(.expr), handlers = .handlers), restarts = .restarts ), envir = env )
-# }
-#
-# zooImageTry( { stop( "fefe" ) }, h.error = function(e) { print ("bla" ) }, h.foo = function(e) "bal", r.error = function(e) 10)
-
More information about the Zooimage-commits
mailing list