### R code from vignette source 'tutorial.Rnw' ################################################### ### code chunk number 1: read-tab (eval = FALSE) ################################################### ## df <- read.table("exptData.txt", header=TRUE) ################################################### ### code chunk number 2: chromos ################################################### chr.lens <- structure(c(247249719L, 242951149L, 199501827L, 191273063L, 180857866L, 170899992L, 158821424L, 146274826L, 140273252L, 135374737L, 134452384L, 132349534L, 114142980L, 106368585L, 100338915L, 88827254L, 78774742L, 76117153L, 63811651L, 62435964L, 46944323L, 49691432L, 154913754L, 57772954L), .Names = c("chr1", "chr2", "chr3", "chr4", "chr5", "chr6", "chr7", "chr8", "chr9", "chr10", "chr11", "chr12", "chr13", "chr14", "chr15", "chr16", "chr17", "chr18", "chr19", "chr20", "chr21", "chr22", "chrX", "chrY")) ################################################### ### code chunk number 3: chr-samples ################################################### set.seed(13245) chr.names <- names(chr.lens) chr.factor <- factor(chr.names,chr.names) chrs <- sample(chr.factor,40000,repl=TRUE, prob=chr.lens) chr.ns <- table(chrs) sample.pos <- function(x,y) sort(sample(y,x,repl=TRUE)) chr.pos <- mapply( sample.pos, chr.ns,chr.lens,SIMPLIFY=FALSE) df <- data.frame(chromo=rep(chr.factor,chr.ns), pos=unlist(chr.pos)) ################################################### ### code chunk number 4: grp-samp ################################################### df$grp <- rbinom(40000, 1, 0.5)==1 ################################################### ### code chunk number 5: null-run ################################################### require(geneRxCluster,quietly=TRUE) null.results <- gRxCluster(df$chromo,df$pos,df$grp,15L:30L,nperm=100L) as.data.frame(null.results)[,c(-4,-5)] ################################################### ### code chunk number 6: grxsmry ################################################### gRxSummary( null.results ) ################################################### ### code chunk number 7: sim-true ################################################### clump.chrs <- sample(chr.factor,30,repl=TRUE, prob=chr.lens) ################################################### ### code chunk number 8: tutorial.Rnw:182-184 ################################################### clump.chr.pos.bound <- sapply(chr.lens[clump.chrs], function(y) sample.pos(1,y)) ################################################### ### code chunk number 9: tutorial.Rnw:189-190 ################################################### clump.site.ns <- rep(c(15,25,40),each=10) ################################################### ### code chunk number 10: tutorial.Rnw:195-209 ################################################### clump.sites <- lapply(seq_along(clump.chrs), function(x) { chromo <- clump.chrs[x] n <- clump.site.ns[x] ctr <- clump.chr.pos.bound[x] chrLen <- chr.lens[chromo] if (ctr