Nothing
#' summary
#' @method summary editmatrix
#' @param object an R object
#' @param useBlocks \code{logical} Summarize each block?
#' @param ... Arguments to pass to or from other methods
#'
#' @rdname editmatrix
#' @export
#' @example ../examples/editmatrix.R
summary.editmatrix <- function(object, useBlocks=TRUE, ...){
if (useBlocks){
B <- blocks(object)
} else {
B <- list(object)
}
A <- array(c(
sapply(B,nrow),
sapply(B,function(b) sum(getOps(b) == '==')),
sapply(B,function(b) sum(getOps(b) != '==')),
sapply(B,function(b) length(getVars(b)) )
),
dim=c(length(B),4),
dimnames=list(
block = 1:length(B),
count = c('edits','equalities','inequalities','variables')
)
)
structure(A,
class=c('editsummary'),
type ='editmatrix',
normalized = isNormalized(object))
}
#' summary
#'
#'
#' @param object an R object
#' @param useBlocks \code{logical} Summarize each block?
#' @method summary editarray
#' @rdname editarray
#' @export
#' @example ../examples/editarray.R
summary.editarray <- function(object, useBlocks=TRUE, ...){
if ( useBlocks ){
B <- blocks(object)
} else {
B <- list(object)
}
A <- array(c(
sapply(B,nrow),
sapply(B,function(b) length(getVars(b)))
),
dim=c(length(B),2),
dimnames=list(
block=1:length(B),
count=c('edits','variables')
)
)
structure(A,
class='editsummary',
type ='editarray')
}
#' summary
#' @param object an R object
#' @param useBlocks \code{logical} Summarize each block?
#' @method summary editset
#'
#' @rdname editset
#' @export
#' @example ../examples/editset.R
summary.editset <- function(object, useBlocks=TRUE, ...){
if ( useBlocks ){
B <- blocks(object)
} else {
B <- list(object)
}
A <- array(c(
sapply(B,nedits),
sapply(B, function(b) nrow(b$num)),
sapply(B, function(b) nrow(b$mixcat)),
sapply(B, function(b) length(getVars(b)))
),
dim=c(length(B),4),
dimnames=list(
block=1:length(B),
count=c('edits','num.edits','mix.edits','variables')
)
)
structure(A,
class='editsummary',
type ='editset')
}
#' summary
#' @method print editsummary
#' @export
#' @keywords internal
print.editsummary <- function(x,...){
nrm <- ''
if ( attr(x,'type')=='editmatrix' ){
nrm <- 'normalized'
if (!attr(x,'normalized')) nrm = paste('non-',nrm,sep='')
}
cat('Summary of',nrm,attr(x,'type'),'\n')
print(x[,,drop=FALSE])
}
#' summary
#' @param object an R object
#' @method summary errorLocation
#' @rdname errorLocation
#' @export
#' @example ../examples/localizeErrors.R
summary.errorLocation <- function(object,...){
prb <- c(0,0.5,1)
err.per.var <- c(quantile(colSums(object$adapt,na.rm=TRUE),probs=prb,names=FALSE))
err.per.rec <- c(quantile(rowSums(object$adapt,na.rm=TRUE),probs=prb,names=FALSE))
A <- sapply(object$status[,1:5], function(x) quantile(x,probs=prb,names=FALSE,na.rm=TRUE))
dimnames(A) <- list(c('min','median','max'), status=names(object$status)[1:5])
A <- cbind(err.per.var,err.per.rec,A)
tt <- sum(object$adapt,na.rm=TRUE)
total <- c(tt,tt,colSums(object$status[,1:5],na.rm=TRUE))
te <- sum(object$status$maxDurationExceeded)
tf <- sum(is.na(object$status$weight))
structure(rbind(A,total),
nexceeded = c(te,te/nrow(object$adapt)),
nnotfound = c(tf,tf/nrow(object$adapt)),
user = object$user,
timestamp = object$timestamp,
call = as.character(as.expression(object$call)),
class=c('locationsummary')
)
}
#' summary
#' @method print locationsummary
#' @export
#' @keywords internal
print.locationsummary <- function(x,...){
cat("Summary of 'errorLocation' object, generated by",attr(x,'user'),'at',attr(x,'timestamp'),'\n')
cat("by calling",attr(x,'call'),'\n\n')
cat('Results:\n')
print(x[,,drop=FALSE])
cat(attr(x,'nexceeded')[1],
' records exceeded maximum search time (',
round(attr(x,'nexceeded')[2]*100,2), '%)\n',sep='')
cat(attr(x,'nnotfound')[1],
' records did not yield a solution (',
round(attr(x,'nnotfound')[2]*100,2), '%)\n',sep='')
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.