MrFlick
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| between <- function(x, a, b) { | |
| if(missing(b)) { | |
| if(length(a)==2) { | |
| a<-t(a) | |
| } | |
| } else { | |
| a <- unname(cbind(a,b)) | |
| } | |
| a<-t(apply(a,1,sort, na.last=T)) | |
| a[,1] <= x & x <= a[,2] |
MrFlick
/ as.table.data.frame.R
Created
May 9, 2014 18:38
as.table.data.frame.R: converts a table-like data frame to a table.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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]) | |
| } |
MrFlick
/ test.uniqueify.R
Last active
August 29, 2015 14:00
uniqueify.R: Looks for duplicate values in a vector and assigns them a unique index in the order in which they appear
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ getExpressionStrip.R
Last active
August 29, 2015 14:00
getExpressionStrip.R: allows for the easy inclusion of math (expressions) in Lattice panel strips
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ Expand.Grid.R
Last active
August 29, 2015 14:00
Expand.Grid.R: A slight modification to expand.grid() such that when you pass data.frames in, the rows are kept together as tuples rather than being split apart
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ read.stack.R
Last active
August 29, 2015 14:00
read.stack.R: reads a list of files into a single data.frame and allows you to add extra columns to each
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ print.plotlist.R
Last active
July 28, 2016 02:43
print.plotlist.R: prints a list of lattice plots with a layout()-like argument
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ qqunif.plot.R
Created
April 11, 2014 15:29
qqunif.plot: Produces a -log10 uniform QQ plot with confidence intervals.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ regcapturedmatches.R
Last active
October 20, 2023 20:25
regcapturedmatches.R: extracts captured matches from match data obtained by regexpr, gregexpr or regexec
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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
/ coalesce.R
Created
April 8, 2014 22:59
Coalesce.R: A coalesce function for R (returns first non-NA value from a list of vectors)
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 { |