MrFlick

table.shingle<-function(..., as.data.frame=F) {
	dots<-list(...)
	if(is.logical(as.data.frame) && as.data.frame) {
		as.data.frame <- list(collapse=T)		
	}
	stopifnot(all(sapply(dots, class) %in% c("shingle","factor")))
	stopifnot(length(unique(sapply(dots, length)))==1)
	if(is.list(as.data.frame) && !as.data.frame$collapse) {
		for(i in which(sapply(dots, class)=="shingle")) {
			pts<-unique(sort(unlist(levels(dots[[i]]))))

MrFlick

coalesce<-function(...) {
    x<-lapply(list(...), function(z) {if (is.factor(z)) as.character(z) else z})
    m<-is.na(x[[1]])
    i<-2
    while(any(m) & i<=length(x)) {
        if ( length(x[[i]])==length(x[[1]])) {
            x[[1]][m]<-x[[i]][m]
        } else if (length(x[[i]])==1) {
            x[[1]][m]<-x[[i]]
        } else {

MrFlick

regcapturedmatches<-function(x,m) {
  
  if (length(x) != length(m))
    stop(gettextf("%s and %s must have the same length",
                  sQuote("x"), sQuote("m")), domain = NA)
  
  ili <- is.list(m)
  useBytes <- if (ili) {
    any(unlist(lapply(m, attr, "useBytes")))
  } else {

MrFlick

library(lattice)
qqunif.plot<-function(pvalues, 
        should.thin=T, thin.obs.places=2, thin.exp.places=2, 
        xlab=expression(paste("Expected (",-log[10], " p-value)")),
        ylab=expression(paste("Observed (",-log[10], " p-value)")), 
        draw.conf=TRUE, conf.points=1000, conf.col="lightgray", conf.alpha=.05,
        already.transformed=FALSE, pch=20, aspect="iso", prepanel=prepanel.qqunif,
        par.settings=list(), ...) {
 
        #error checking

MrFlick

print.plotlist<-function(xx, layout=matrix(1:length(xx), nrow=1), more=F) {
	lty<-NULL
	if ( is.matrix(layout) ) {
		lyt <- layout
		col.widths <- rep.int(1, ncol(lyt))
		row.heights <- rep.int(1, nrow(lyt))
	} else if ( is.list(layout) ) {
		stopifnot(class(layout[[1]]) == "matrix")
		lyt <- layout[[1]]
		col.widths <- if (!is.null(layout$widths)) layout$widths else rep.int(1, ncol(lyt))

MrFlick

read.stack <- function(files, ..., select=NULL, extra=NULL, reader=read.table) {
    dd<-data.frame()
    if(!is.null(extra)) {
        stopifnot(is.list(extra))
        stopifnot(all(sapply(extra, length)==length(files)))
    }
    for(i in 1:length(files)) {
        d<-reader(files[i], ...)
        if(!is.null(select)) {
            stopifnot(all(select %in% names(d)))

MrFlick

Expand.Grid<-function (..., stringsAsFactors = TRUE) 
{
    nargs <- length(args <- list(...))
    if (!nargs) 
        return(as.data.frame(list()))
    if (nargs == 0L) 
        return(as.data.frame(list()))
    Names <- function(x) {if(!is.null(names(x))) names(x) else rep("",length(x))}
    Paste <- function(...) {a<-list(...); r<-do.call("paste", c(list(sep="."),
        a[sapply(a, function(x) !is.character(x) || any(nzchar(x)))]));

MrFlick

getExpressionStrip <- function(...) {
        dots<-list(...)
        if (length(dots)==0) return(strip.default)
        if (class(dots[[1]])=="list") {
                rename <- dots[[1]]
                stripparam <- dots[-1]
        } else {
                rename <- dots
                stripparam <- list()
        }

MrFlick

x<-c(4, 1, 1, 3, 5, 3, 2, 4, 2, 5)
y<-uniqueify(x)
 
#x has no "primary key", but (x,y) will uniquely identify values (no duplicates)
cbind(x, y)

MrFlick

as.table.data.frame<-function(x, rownames=0) {
    numerics <- sapply(x,is.numeric)
    chars <- which(sapply(x,function(x) is.character(x) || is.factor(x)))
    names <- if(!is.null(rownames)) {
        if (length(rownames)==1) {
            if (rownames ==0) {
                 rownames(x)
            } else {
                as.character(x[,rownames])
            }