[med-svn] [r-other-valdar-bagpipe.backend] 05/07: New upstream version 0.34
Andreas Tille
tille at debian.org
Wed Dec 27 17:05:55 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-other-valdar-bagpipe.backend.
commit 8b898997dfcd217a51333a92b1478f033b2004da
Author: Andreas Tille <tille at debian.org>
Date: Wed Dec 27 18:04:13 2017 +0100
New upstream version 0.34
---
DESCRIPTION | 14 +
NAMESPACE | 11 +
R/DiploprobReaderClass.R | 219 ++++++
R/WVhash.R | 41 +
R/WVmisc.R | 383 +++++++++
R/WVmisc_mdlist.R | 70 ++
R/WVmisc_stack.R | 43 +
R/bagpipe_exception.R | 13 +
R/bagpipe_formula.R | 425 ++++++++++
R/bagpipe_genome_scan.R | 825 ++++++++++++++++++++
R/bagpipe_happy_graphics.R | 550 +++++++++++++
R/bagpipe_posboot.R | 153 ++++
R/bagpipe_undernull.R | 212 +++++
R/bagpipe_utils.R | 222 ++++++
R/cmdline.R | 119 +++
R/configfile.R | 85 ++
R/lmmultiresponse.R | 295 +++++++
R/read.happy.core.R | 466 +++++++++++
R/read.happy.derived.R | 868 +++++++++++++++++++++
R/read.happy.genotype.R | 66 ++
R/read.happy.reserve.R | 103 +++
R/unify.R | 458 +++++++++++
debian/changelog | 6 -
debian/compat | 1 -
debian/control | 34 -
debian/rules | 8 -
debian/source/format | 1 -
debian/watch | 3 -
man/DEFAULT.REDUCE.DMAT.CUTOFF.Rd | 28 +
man/DiploprobReader-class.Rd | 82 ++
man/ENV.Rd | 56 ++
man/SS.Rd | 58 ++
man/apply.permutation.matrix.Rd | 72 ++
man/apply.transform.Rd | 65 ++
man/assert.happy.Rd | 59 ++
man/bagpipe.backend-package.Rd | 43 +
man/bagpipe.data.error.Rd | 58 ++
man/bagpipe.define.posboot.loci.Rd | 77 ++
man/bagpipe.expand.formula.Rd | 204 +++++
man/bagpipe.extract.loci.Rd | 72 ++
man/bagpipe.formula.decipher.Rd | 88 +++
man/bagpipe.formula.encipher.locus.Rd | 62 ++
man/bagpipe.formula.error.Rd | 58 ++
man/bagpipe.formula.extractor.lookup.Rd | 82 ++
man/bagpipe.formula.has.abstract.loci.Rd | 58 ++
man/bagpipe.formula.reserved.variables.Rd | 58 ++
man/bagpipe.get.design.Rd | 115 +++
man/bagpipe.init.posboot.file.Rd | 78 ++
man/bagpipe.input.error.Rd | 58 ++
man/bagpipe.parse.sdp.string.Rd | 72 ++
man/bagpipe.posboot.scan.Rd | 90 +++
man/bagpipe.read.configfile.Rd | 65 ++
man/caught.error.Rd | 57 ++
man/cmdline.flag.Rd | 40 +
man/cmdline.has.option.Rd | 40 +
man/cmdline.integer.Rd | 42 +
man/cmdline.integers.Rd | 43 +
man/cmdline.logical.Rd | 41 +
man/cmdline.logicals.Rd | 42 +
man/cmdline.numeric.Rd | 41 +
man/cmdline.numerics.Rd | 40 +
man/cmdline.option.Rd | 78 ++
man/cmdline.string.Rd | 39 +
man/cmdline.strings.Rd | 49 ++
man/cols.as.Rd | 104 +++
man/configfile.get.Rd | 72 ++
man/configfile.has.Rd | 60 ++
man/configfile.integer.Rd | 63 ++
man/configfile.integers.Rd | 63 ++
man/configfile.logical.Rd | 63 ++
man/configfile.numeric.Rd | 63 ++
man/configfile.numerics.Rd | 63 ++
man/configfile.string.Rd | 72 ++
man/configfile.strings.Rd | 72 ++
man/dfapply.Rd | 71 ++
man/do.scan.Rd | 107 +++
man/drop.formula.vars.Rd | 73 ++
man/elem.Rd | 64 ++
man/find.peaks.Rd | 83 ++
man/find.windowed.peaks.Rd | 82 ++
man/fit.gev.Rd | 69 ++
man/force.logical.Rd | 66 ++
man/formula.as.string.Rd | 56 ++
man/freeman.tukey.Rd | 58 ++
man/general.multiscan.Rd | 111 +++
man/general.scan.Rd | 146 ++++
man/genotype.to.count.Rd | 73 ++
man/genotype.to.factor.Rd | 65 ++
man/genotype.to.hier.Rd | 70 ++
man/get.phenotype.data.Rd | 196 +++++
man/happy.check.bp.Rd | 78 ++
man/happy.clear.reserve.Rd | 61 ++
man/happy.get.allele.freq.Rd | 71 ++
man/happy.get.allowed.models.Rd | 53 ++
man/happy.get.bp.Rd | 61 ++
man/happy.get.chromosome.Rd | 62 ++
man/happy.get.chromosome.length.Rd | 87 +++
man/happy.get.design.Rd | 134 ++++
man/happy.get.design.old.Rd | 134 ++++
man/happy.get.diplotype.tensor.Rd | 116 +++
man/happy.get.first.marker.Rd | 70 ++
man/happy.get.genome.location.Rd | 126 +++
man/happy.get.genotype.Rd | 90 +++
man/happy.get.interval.length.Rd | 99 +++
man/happy.get.interval.midpoint.Rd | 69 ++
man/happy.get.interval.over.Rd | 111 +++
man/happy.get.interval.range.Rd | 76 ++
man/happy.get.intervals.Rd | 61 ++
man/happy.get.intervals.in.range.Rd | 112 +++
man/happy.get.last.marker.Rd | 65 ++
man/happy.get.location.Rd | 65 ++
man/happy.get.markers.Rd | 99 +++
man/happy.get.markers.between.Rd | 98 +++
man/happy.get.models.Rd | 59 ++
man/happy.get.next.marker.Rd | 86 ++
man/happy.get.position.Rd | 62 ++
man/happy.get.previous.marker.Rd | 73 ++
man/happy.get.reserve.limit.Rd | 58 ++
man/happy.get.reserved.marker.Rd | 65 ++
man/happy.get.strains.Rd | 58 ++
man/happy.get.subjects.Rd | 58 ++
man/happy.has.chromosomes.Rd | 64 ++
man/happy.has.markers.Rd | 64 ++
man/happy.has.model.Rd | 62 ++
man/happy.has.reserved.marker.Rd | 66 ++
man/happy.has.subjects.Rd | 61 ++
man/happy.init.reserve.Rd | 74 ++
man/happy.is.auto.reserve.Rd | 60 ++
man/happy.list.chromosomes.Rd | 72 ++
man/happy.load.data.Rd | 83 ++
man/happy.load.genome.Rd | 146 ++++
man/happy.load.marker.Rd | 136 ++++
man/happy.make.colnames.Rd | 82 ++
man/happy.make.genome.location.Rd | 111 +++
man/happy.matrixop.diplotypes.to.full.Rd | 73 ++
...happy.matrixop.full.asymmetric.to.diplotypes.Rd | 61 ++
man/happy.matrixop.full.to.diplotypes.Rd | 64 ++
man/happy.num.strains.Rd | 58 ++
man/happy.plot.intervals.Rd | 261 +++++++
man/happy.plot.ladder.Rd | 146 ++++
man/happy.plot.ladder.chr.list.Rd | 80 ++
man/happy.reserve.exists.Rd | 58 ++
man/happy.reserve.get.Rd | 64 ++
man/happy.reserve.has.Rd | 73 ++
man/happy.reserve.has.scratch.Rd | 58 ++
man/happy.reserve.marker.Rd | 76 ++
man/happy.reserve.markers.Rd | 102 +++
man/happy.reserve.memory.usage.Rd | 61 ++
man/happy.reserve.put.Rd | 74 ++
man/happy.set.auto.reserve.Rd | 62 ++
man/hasS3method.Rd | 63 ++
man/hasS4method.Rd | 68 ++
man/hash.get.Rd | 61 ++
man/hash.has.Rd | 61 ++
man/hash.keys.Rd | 58 ++
man/hash.memory.usage.Rd | 62 ++
man/hash.put.Rd | 64 ++
man/hash.remove.Rd | 61 ++
man/ifow.Rd | 66 ++
man/igrep.Rd | 73 ++
man/incidence.matrix.Rd | 57 ++
man/interpolate.Rd | 86 ++
man/interpolate.Sys.env.Rd | 51 ++
man/invlogit.Rd | 57 ++
man/is.formula.Rd | 35 +
man/is.informative.predictor.Rd | 67 ++
man/is.nullOrEmpty.Rd | 65 ++
man/is.wholenumber.Rd | 60 ++
man/list.has.Rd | 64 ++
man/list.subdirs.Rd | 65 ++
man/lm.multiresponse.Rd | 168 ++++
man/lm.multiscan.Rd | 107 +++
man/load.gscan.Rd | 94 +++
man/logit.Rd | 57 ++
man/make.parboot.permutation.matrix.Rd | 95 +++
man/make.parboot.permuted.responses.Rd | 82 ++
man/make.parboot.responses.Rd | 88 +++
man/make.permuted.responses.Rd | 74 ++
man/make.posboot.summary.Rd | 79 ++
man/make.posboot.summary.ci.Rd | 69 ++
man/make.reduce.dmat.fun.Rd | 74 ++
man/make.step.data.Rd | 78 ++
man/map.eq.Rd | 79 ++
man/mdlist.get.Rd | 67 ++
man/mdlist.has.Rd | 78 ++
man/mdlist.put.Rd | 78 ++
man/new.hash.Rd | 53 ++
man/object.sizes.Rd | 76 ++
man/permutation.matrix.Rd | 97 +++
man/polygonh.Rd | 68 ++
man/pop.back.Rd | 60 ++
man/pop.front.Rd | 60 ++
man/push.back.Rd | 67 ++
man/push.front.Rd | 64 ++
man/read.configfile.Rd | 67 ++
man/read.scan.file.Rd | 83 ++
man/reduce.dim.Rd | 72 ++
man/scan.phenotype.Rd | 119 +++
man/se.mean.Rd | 63 ++
man/split.formula.Rd | 42 +
man/split.pathname.Rd | 50 ++
man/strcat.Rd | 61 ++
man/string.trim.Rd | 56 ++
man/tr.Rd | 56 ++
man/unify.aic.Rd | 58 ++
man/unify.anova.Rd | 104 +++
man/unify.anova.list.Rd | 197 +++++
man/unify.bic.Rd | 61 ++
man/unify.deviance.Rd | 65 ++
man/unify.fit.Rd | 120 +++
man/unify.generic.model.type.Rd | 59 ++
man/unify.has.model.type.Rd | 58 ++
man/unify.is.multilevel.formula.Rd | 67 ++
man/unify.logLik.Rd | 68 ++
man/unify.model.types.Rd | 58 ++
man/unify.num.obs.Rd | 59 ++
man/unify.num.params.Rd | 59 ++
man/unify.simulate.Rd | 79 ++
man/unify.simulate.lmer.Rd | 71 ++
man/which.wide.ci.Rd | 76 ++
man/wlm.multiresponse.Rd | 157 ++++
man/write.configfile.Rd | 62 ++
man/write.delim.Rd | 66 ++
man/write.multiscan.max.Rd | 65 ++
man/write.scan.Rd | 74 ++
225 files changed, 20513 insertions(+), 53 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..9ee3678
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,14 @@
+Package: bagpipe.backend
+Type: Package
+Title: A bundled set of functions supporting the bagpipe program for
+ mapping QTLs
+Version: 0.34
+Date: 2015-05-28
+Author: William Valdar
+Depends: g.data (>= 2.0), MASS, evd, methods (>= 3.1.3)
+Suggests: lme4 (>= 1.1-7), Matrix (>= 1.2-0), multicore
+Maintainer: <william.valdar at unc.edu>
+Description: More about what it does (maybe more than one line)
+License: GPL version 2 or newer
+LazyLoad: yes
+Packaged: 2015-05-29 13:11:01 UTC; wvaldar
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..759f6a5
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,11 @@
+# Default NAMESPACE created by R
+# Remove the previous line if you edit this file
+
+# Export all names
+exportPattern(".")
+
+# Import all packages listed as Imports or Depends
+import(
+ g.data,
+ MASS
+)
diff --git a/R/DiploprobReaderClass.R b/R/DiploprobReaderClass.R
new file mode 100644
index 0000000..825d114
--- /dev/null
+++ b/R/DiploprobReaderClass.R
@@ -0,0 +1,219 @@
+
+#' Class for a DiploprobReader object
+
+DiploprobReader <- setRefClass("DiploprobReader",
+ fields = c(
+ "mHappy"
+ ), # = "happy.genome"
+ methods = list(
+ #
+ #
+ initialize = function(dataDir, format=c("happy"), ...){
+ if (inherits(dataDir, "happy.genome")){
+ .self$mHappy <- dataDir
+ warning("DiploprobReader initization from happy objects will be phased out in future versions.\n")
+ } else if ("happy"==format[1]){
+ .self$mHappy <- happy.load.genome(dataDir)
+ } else {
+ stop("Unknown format ", format, "\n")
+ }
+ callSuper(...)
+ },
+# getAllowedModels = function(){
+# },
+ getChromEnd = function(chrom, scale){
+ .self$getLocusEnd(tail(.self$getLoci(chrom), 1), scale=scale)
+ },
+ getChromStart = function(chrom, scale){
+ .self$getLocusStart(.self$getLoci(chrom)[1], scale=scale)
+ },
+ getChromLength = function(chrom, scale){
+ 'Returns the length of the specified chromosome in units of the specified scale
+ '
+ happy.get.chromosome.length(.self$mHappy, chrom=chrom, scale=scale)
+ },
+ getChromList = function(){
+ 'Returns a character vector of the chromosome names
+ '
+ happy.list.chromosomes(.self$mHappy)
+ },
+ getChromOfLocus = function(loci){
+ 'Returns a character vector containing the name(s) of the chromosome(s) to which the specified loci belong
+ '
+ happy.get.chromosome(.self$mHappy, loci)
+ },
+ getGenotype = function(marker, ...){
+ 'Returns a vector containing the genotypes observed for the specified marker, with NA for
+ missing genotypes'
+ as.character(happy.get.genotype(.self$mHappy, marker=marker, genotype.model="factor"))
+ },
+ getLocusMatrix = function(locus, model, subjects=NULL, as.data.frame=FALSE, sdp=NULL){
+ 'Get matrix representing average probabilities or expectations of haplotypes
+ over the interval
+ '
+ happy.get.design(.self$mHappy, marker=locus, model=model, as.data.frame=as.data.frame, sdp=sdp, subjects=subjects)
+ },
+ getLocusProbTensor = function(locus, model, subjects=NULL, simplify=FALSE, memoize.last=TRUE){
+ '
+ For n subjects descended from J strains, this function returns a tensor
+ of n JxJ matrices. Each matrix gives the probability that a randomly
+ chosen point within the locus interval is descended from a particular diplotype.
+
+ model: When model = full.asymmetric, the diplotype probability matrix distinguishes
+ between diplotype AB and BA for founders A and B. When model = full, these
+ probabilities are set to be equal. Depending on how the HMM probabilities were
+ estimated, full.asymmetric may not be available.
+
+ simplify: When simplify=TRUE and only one subject is specified, the return value is
+ simplified from a 1xJxJ tensor to a JxJ matrix.
+
+ memoize.last: An optimization for when it is expected that the same tensor will be
+ requested repeatedly. Setting memoize.last=TRUE causes the method to make
+ an internal cache of the last return value. If the exact same tensor is requested,
+ then the method returns the cached value, thereby avoiding the cost of repeating
+ various operations that may include file I/O.
+ '
+ if (missing(subjects)){
+ subjects <- .self$getSubjects()
+ }
+ happy.get.diplotype.tensor(.self$mHappy, marker=locus, model=model, subjects=subjects, memoize=memoize.last, simplify=simplify)
+ },
+ getFirstLocus = function(chrom){
+ 'Returns the name of the first locus on the specified chromosome
+ '
+ happy.get.first.marker(.self$mHappy, chrom=chrom)
+ },
+ getFounders = function(){
+ 'Returns a character vector of the founder names
+ '
+ happy.get.strains(.self$mHappy)
+ },
+ getLastLocus = function(chrom){
+ 'Returns the name of the last locus on the specified chromosome
+ '
+ happy.get.last.marker(.self$mHappy, chrom=chrom, as.intervals=TRUE)
+ },
+ getLocusWidth = function(loci, scale){
+ 'Returns a numeric vector containing, for each specified locus, the left-to-right width in the
+ units of the specified scale
+ '
+ happy.get.interval.length(.self$mHappy, loci, scale=scale)
+ },
+ getLoci = function(chrom=NULL, before=NULL, after=NULL, from=NULL, to=NULL, scale="interval", over=NULL){
+ 'Returns a character vector of the locus names
+ '
+ if (missing(before) & missing(after) & missing(from) & missing(to) & missing(scale)){
+ return (happy.get.markers(.self$mHappy, chrom=chrom))
+ } else {
+ warning("Incompletely debugged code for getLoci\n")
+ }
+ if (!is.null(from)) {
+ return (happy.get.intervals.in.range(h, chromosome=chrom, markers=loci, from=from, to=to))
+ } else if (!is.null(over)) {
+ return (happy.get.interval.over(.self$mHappy, chromosome=chrom, scale=scale))
+ } else {
+ return (happy.get.markers.between(.self$mHappy, before=before, after=after, as.intervals=TRUE))
+ }
+ },
+ getMarkers = function(){
+ '
+ '
+ happy.get.markers(.self$mHappy, model="genotype")
+ },
+ getLociInRange = function(from=NULL, to=NULL, scale="locus", chr=NULL){
+ happy.get.intervals.in.range(.self$mHappy, from=from, to=to, chr=chr,
+ scale=ifelse("locus"==scale, "interval", scale))
+ },
+ getLocusOver = function(x, scale, chr){
+ happy.get.interval.over(.self$mHappy, x, scale=scale, chr=chr)
+ },
+ getLocusEnd = function(loci, scale){
+ .self$getLocusRange(loci, scale)[, 2]
+ },
+ getLocusStart = function(loci, scale){
+ .self$getLocusRange(loci, scale)[, 1]
+ },
+ getLocusRange = function(loci, scale){
+ 'Returns the left and right boundaries of the specified loci, in units of the specified scale
+ '
+ happy.get.interval.range(.self$mHappy, markers=loci, scale=scale)
+ },
+ getMarkerLocation = function(markers, scale){
+ 'Returns the location of the specified marker(s) in units of the specified scale
+ '
+ happy.get.location(.self$mHappy, markers, scale=scale)
+ },
+ getNextMarker = function(markers){
+ 'Returns the next marker along, or NA if at the end of the chromosome
+ '
+ happy.get.next.marker(.self$mHappy, markers)
+ },
+ getNumFounders = function(){
+ 'Returns the number of founders
+ '
+ length(.self$getFounders())
+ },
+ getNumSubjects = function(){
+ 'Returns the number of subjects
+ '
+ length(.self$getSubjects())
+ },
+ getSubjects = function(){
+ 'Returns a character vector of the subject names
+ '
+ happy.get.subjects(.self$mHappy)
+ },
+ hasChrom = function(chrom){
+ 'Returns logical vector indicating whether the specified chromosomes exist
+ '
+ happy.has.chromosome(.self$mHappy, chrom)
+ },
+ hasLoci = function(loci){
+ 'Returns logical vector indicating whether loci with the specified names exist
+ '
+ happy.has.markers(.self$mHappy, loci)
+ },
+ hasMarkers = function(markers){
+ 'Returns logical vector indicating whether markers with the specified names exist. Compare $hasLoci()$.
+ '
+ markers %in% happy.get.markers(.self$mHappy, model = "genotype", as.intervals = FALSE)
+ },
+ hasSubjects = function(subjects){
+ 'Returns logical vector indicating whether subjects with the specified names exist
+ '
+ happy.has.subjects(.self$mHappy, subjects)
+ },
+ help = function(...){
+ DiploprobReader$help(...)
+ },
+ methods = function(...){
+ DiploprobReader$methods(...)
+ },
+ updateBp = function(markerBpTable, allowPartial=FALSE){
+ 'Update base pair positions of the markers. Handy when bp positions were unavailable or misspecified at the time of generating the genome cache. $markerBpTable$ is a data.frame with two columns: the first should have the locus name, the second should have the bp position. $allowPartial$ permits updating of a subset of the markers; by default this is set to FALSE.
+ '
+ # ideally this should be modifying one global lookup, but the current happy object is not structured that way.
+ # TODO: store bp information in *one* central location, not duplicated in every model!!!
+ models <- setdiff(names(.self$mHappy), c("subjects", "strains", "markers"))
+ for (model in models){
+ tab <- data.frame(markers=I(as.character(markerBpTable[, 1])), bp=as.integer(markerBpTable[, 2]))
+ drMarkers <- .self$mHappy[[model]]$genome$marker
+ tab <- tab[tab$markers %in% drMarkers, ]
+ if (!allowPartial){
+ missingMarkers <- setdiff(tab$markers, drMarkers)
+ if (0<length(missingMarkers)){
+ stop("Cannot update base pairs in method $updateBp()$: new marker data is short by ", length(missingMarkers), " markers. Either give complete set or set allowPartial flag to true")
+ }
+ }
+ #
+ i.replace <- match(tab$markers, drMarkers)
+ .self$mHappy[[model]]$genome$bp[i.replace] <- tab$bp
+ }
+ }
+ ) # end method defs
+) # end ref class def
+
+
+
+
+
diff --git a/R/WVhash.R b/R/WVhash.R
new file mode 100644
index 0000000..f6d66fa
--- /dev/null
+++ b/R/WVhash.R
@@ -0,0 +1,41 @@
+# Valdar's environment-based hashtable.
+
+new.hash <- function()
+{
+ new.env(hash=TRUE)
+}
+
+hash.has <- function(hash, key)
+{
+ exists(as.character(key), envir=hash, inherits=FALSE)
+}
+
+hash.get <- function(hash, key)
+{
+ get(as.character(key), envir=hash, inherits=FALSE)
+}
+
+hash.put <- function(hash, key, value)
+{
+ assign(as.character(key), envir=hash, value=value)
+}
+
+hash.keys <- function(hash)
+{
+ ls(envir=hash)
+}
+
+hash.memory.usage <- function(hash)
+{
+ total <- 0
+ for (k in hash.keys(hash))
+ {
+ total <- total + object.size(hash.get(hash, k))
+ }
+ total
+}
+
+hash.remove <- function(hash, key)
+{
+ rm(envir=hash, list=key)
+}
diff --git a/R/WVmisc.R b/R/WVmisc.R
new file mode 100644
index 0000000..a277b57
--- /dev/null
+++ b/R/WVmisc.R
@@ -0,0 +1,383 @@
+
+caught.error <- function(x)
+# simple catch for try()
+{
+ inherits(x, "try-error")
+}
+
+dfapply <- function(data, INDICES, FUN, results=list(), results.add.FUN=c, matched.vector=FALSE, pass.key=is.list(INDICES), ...)
+# Function for processing each cell of a ragged array when the array is a data frame. An alternative to by()
+{
+ idata <- as.data.frame(INDICES)
+ udata <- unique(idata)
+ if (matched.vector)
+ {
+ results <- rep(NA, nrow(data))
+ }
+ for (ui in 1:nrow(udata))
+ {
+ di <- rep(TRUE, nrow(data))
+ for (cn in colnames(udata))
+ {
+ di <- di & as.character(udata[ui,cn])==as.character(idata[,cn])
+ }
+ u <- udata[ui,]
+ if (!is.data.frame(u)) {
+ u <- data.frame(u)
+ colnames(u) = colnames(udata)
+ }
+ if (pass.key) {
+ result <- FUN(data[di,], u, ...)
+ } else { # allow for really simple operations
+ result <- FUN(data[di,], ...)
+ }
+
+ if (matched.vector){
+ results[which(di)] <- result
+ } else {
+ results <- results.add.FUN(results, result)
+ }
+ }
+ results
+}
+
+
+
+elem <- function(x, start=1, end=length(x))
+{
+ ifow(0==length(x), integer(0), start:end)
+}
+
+force.logical <- function(x, null=FALSE, na=FALSE, empty=FALSE, blank=FALSE)
+#
+#
+# Problem definition: Rs "if" statements evaluate all conditions whether
+# or not it is necessary to do so. Eg,
+# x <- NA
+# ...
+# if (!is.na(x) & x > 0)
+# The above condition will evaluate as (FALSE & NA) -> (NA) -> throw error,
+# whereas in other languages the second component is not evaluated if the
+# first is FALSE and no error would be thrown. The default solution to this
+# is to use multiple nested if statments like
+# if (!is.na(x)) { if (x>0) {
+# However, that is expensive on nesting and brackets.
+# A better alternative:
+# if (!is.na(x) & force.logical(x>0))
+# or more explicitly
+# if (!is.na(x) & force.logical(x>0, na=FALSE))
+# or, for this example, most concisely
+# if (force.logical(x>0))
+# Whichever, this means the condition requires only one if statement.
+{
+ if (is.null(x))
+ {
+ return (null)
+ }
+ if (0==length(x))
+ {
+ return (empty)
+ }
+ if (any(is.na(x)))
+ {
+ x[is.na(x)] <- na
+ }
+ if (is.character(x))
+ {
+ i <- nchar(x)==0
+ x[i] <- FALSE
+ x[!i] <- TRUE
+ }
+ as.logical(x)
+}
+
+formula.as.string <- function(x)
+# Converts a formula object into a character string
+# If x is a list of formula objects, a character vector of the same
+# length is returned. If x is a string or vector of strings, then x is
+# returned unchanged.
+{
+ if (is.character(x))
+ {
+ return (x)
+ }
+ if (is.formula(x))
+ {
+ return (paste(deparse(x), collapse=""))
+ }
+ if (is.list(x))
+ {
+ strings <- NULL
+ for (i in 1:length(x))
+ {
+ strings <- c(strings, formula.as.string(x[[i]]))
+ }
+ return (strings)
+ }
+ stop("Cannot convert object of class ", class(x), " to string\n")
+}
+
+incidence.matrix <- function(fact)
+{
+ m=diag(nlevels(fact))[fact,]
+ colnames(m)=levels(fact)
+ m
+}
+
+
+igrep <- function(pattern, x, ..., value=FALSE, logical=TRUE)
+# pass through method for grep that can return match as an indicator
+# vector
+{
+ if (!value & logical)
+ {
+ indices <- grep(pattern, x, value=value, ...)
+ return (1:length(x) %in% indices)
+ }
+ grep(pattern, x, value=value, ...)
+}
+
+interpolate <- function(x, y, xout, project=1, ...)
+# wrapper for approx() that linearly projects missing data
+# at the front and back. $project determines how many
+# terminal non-missing points are used to calculate a
+# a projection slope.
+{
+ yout <- approx(x, y, xout=xout, ...)$y
+
+ na <- is.na(yout)
+ if (0<project & any(na))
+ {
+ known <- which(!na)
+ if (na[1])
+ {
+ k <- known[1]
+ front <- 1:(k-1)
+ loc <- yout[k]
+ slope <- (yout[k+project]-loc)/project
+ yout[front] <- loc + (front - k)*slope
+ }
+ if (tail(na,1))
+ {
+ k <- tail(known,1)
+ back <- length(yout):k
+ loc <- yout[k]
+ slope <- (loc - yout[k-project])/project
+ yout[back] <- loc + (back - k)*slope
+ }
+ }
+ list(x=xout, y=yout)
+}
+
+interpolate.Sys.env <- function(x, stop.on.fail=FALSE)
+# interpolates environmental shell variables
+# ie, finds each substring x that start with "$" and ends before a "/" or whitespace,
+# and substitutes it with Sys.getenv(x). If Sys.getenv(x) returns an empty string
+# such that there is no environmental variable with that name, then if stop.on.fail
+# is TRUE the function throws an error. Otherwise, the substring is left unsubstituted
+{
+ if (!is.character(x))
+ {
+ stop("Argument to interpolate.Sys.env currently handles only character vectors\n")
+ }
+ if (1!=length(x))
+ {
+ return ( as.character(sapply(x, interpolate.Sys.env, stop.on.fail=stop.on.fail)) )
+ }
+ regmatch <- gregexpr("\\$[^\\/]+", x, perl=TRUE)[[1]]
+ starts <- as.integer(regmatch)
+ lens <- attr(regmatch, "match.length")
+ if (-1==starts[1]) return (x)
+
+ parts <- NULL
+ next.pos <- NULL
+ for (i in 1:length(starts))
+ {
+ if (!is.null(next.pos))
+ {
+ parts <- c(parts, substr(x, next.pos, starts[i]-1) )
+ }
+
+ shellvar <- substr(x, starts[i]+1, lens[i] + starts[i] - 1)
+ value <- Sys.getenv(shellvar)
+ if (""==value)
+ {
+ if (stop.on.fail) stop("Could not get shell environment variable \"$", shellvar, "\"\n")
+ value <- paste("$", sep="", shellvar)
+ }
+ parts <- c(parts, value)
+
+ next.pos <- starts[i] + lens[i]
+ }
+ parts <- c(parts, substr(x, next.pos, nchar(x)))
+ paste(parts, collapse="")
+}
+ENV <- function(...) { interpolate.Sys.env(...) }
+
+ifow=function(test, yes, no)
+{
+ if (test)
+ {
+ return (yes)
+ }
+ no
+}
+
+invlogit <- function(x)
+{
+ exp(x)/(1+exp(x))
+}
+
+is.formula <- function(x)
+# for some reason absent in R base
+{
+ inherits(x, "formula")
+}
+
+is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)
+{
+ abs(x - round(x)) < tol
+}
+
+list.subdirs <- function(path=".", ..., full.names=FALSE)
+{
+ path.names <- list.files(path, ..., full.names=TRUE)
+ files <- list.files(path, ..., full.names=full.names)
+ files[ file.info(path.names)$isdir ]
+}
+
+logit <- function(p)
+{
+ log(p/(1-p))
+}
+
+map.eq <- function(x, lookup=NULL, from=NULL, to=NULL)
+# maps values in vector from $from to $to using == to test equality
+{
+ y <- x
+ if (!is.null(from) & !is.null(to))
+ {
+ if (length(from)!=length(to))
+ {
+ stop("Arguments $from and $to must be the same length\n")
+ }
+ for (k in 1:length(from))
+ {
+ i <- x==from[k]
+ y[i] <- to[k]
+ }
+ }
+ if (!is.null(lookup))
+ {
+ y <- map.eq(y, from=names(lookup), to=unlist(lookup))
+ }
+ return (y)
+}
+
+object.sizes <- function(env=parent.frame(), sort="sd", format="Mb")
+{
+ obs <- objects(name=env)
+ sizes <- numeric(length(obs))
+ for (i in 1:length(obs))
+ {
+ sizes[i] <- eval(parse(text=paste("object.size(",obs[i], ")")), env=env)
+ }
+ names(sizes) <- obs
+
+ if ("sd"==sort)
+ {
+ sizes <- sizes[order(-sizes)]
+ }
+ if ("Mb"==format)
+ {
+ sizes <- round(sizes/2^20, 3)
+ }
+ sizes
+}
+
+se.mean <- function(x, na.rm=FALSE) # std error of the mean
+{
+ n <- sum(!is.na(x))
+ if (n < 2) return (NaN)
+ sd(x, na.rm=na.rm)/sqrt(n)
+}
+
+split.formula <- function(x, simplify=FALSE)
+{
+ terms.object = terms(as.formula(x), simplify=simplify)
+ formula.env = attr(terms.object, ".Environment")
+ formula = paste(string.trim(deparse(terms.object)), collapse="")
+
+ vars <- all.vars(terms.object)
+ facts <- rownames(attr(terms.object, "factors"))
+
+ has.response <- 1==attr(terms.object, "response")
+ has.predictors <- !is.null(facts)
+ has.intercept <- 1==attr(terms.object, "intercept")
+
+ response <- ""
+ response.vars <- NULL
+ if (has.response)
+ {
+ response = string.trim(sub("~.*", "", formula))
+ response.terms.object = terms(
+ as.formula(paste(response,"~1"), env=formula.env)
+ )
+ num.responses = length(all.vars(response.terms.object))
+ response.vars = vars[1:num.responses]
+ }
+
+ predictor.string <- ""
+ predictors <- NULL
+ predictor.vars <- NULL
+ if (has.predictors)
+ {
+ predictor.string = string.trim(sub(".*~", "", formula))
+ predictors.terms.object = terms(
+ as.formula(paste("~",predictor.string), env=formula.env)
+ )
+ predictors = rownames(attr(predictors.terms.object, "factors"))
+ predictor.vars = all.vars(predictors.terms.object)
+ }
+ else
+ {
+ predictor.string = ifelse(has.intercept, "1", "-1")
+ }
+
+ list(
+ formula = formula,
+ response = response,
+ response.vars = response.vars,
+ predictor.string = predictor.string, # formerly `predictors'
+ predictors = predictors,
+ predictor.vars = predictor.vars
+ )
+}
+
+split.pathname <- function(x)
+{
+ list(
+ base = basename(x),
+ dir = dirname(x),
+ ext = sub(".*\\.", "", x),
+ core = sub("\\.[^\\.]+", "", basename(x)))
+}
+
+strcat<-function(...,sep=""){paste(sep=sep,...)}
+
+string.trim <- function(s)
+# trims leading and trailing whitespace from a character vector
+{
+ gsub("^[[:space:]]+", "", gsub("[[:space:]]+$", "", s) )
+}
+
+tr <- function(mat)
+{
+ sum(diag(mat))
+}
+
+write.delim <- function(..., quote=FALSE, row.names=FALSE, sep="\t")
+{
+ write.table(..., sep=sep, quote=quote, row.names=row.names)
+}
+
diff --git a/R/WVmisc_mdlist.R b/R/WVmisc_mdlist.R
new file mode 100644
index 0000000..1baf37e
--- /dev/null
+++ b/R/WVmisc_mdlist.R
@@ -0,0 +1,70 @@
+list.has <- function(x, key)
+# ordinary indexing would throw an error
+{
+ if (is.numeric(key))
+ {
+ return (key <= length(x))
+ }
+ key %in% names(x)
+}
+
+mdlist.get <- function(obj, key)
+# mdlist.*: functions for traversing a multi-dimensional list
+{
+ if (0==length(key))
+ {
+ stop("Argument \'key\' must have at least one element\n")
+ }
+ if (1==length(key))
+ {
+ return (obj[[key, exact=TRUE]])
+ }
+ mdlist.get(obj[[ key[1], exact=TRUE ]], key[-1])
+}
+
+mdlist.has <- function(obj, key)
+# mdlist.*: functions for traversing a multi-dimensional list
+{
+
+ if (0==length(key))
+ {
+ stop("Argument \'key\' must have at least one element\n")
+ }
+ if (1==length(key))
+ {
+ return (list.has(obj, key))
+ }
+ if (1 < length(key))
+ {
+ if (!list.has(obj,key[1]))
+ {
+ return (FALSE)
+ }
+ return (mdlist.has(obj[[ key[1] ]], key[-1]))
+ }
+}
+
+
+mdlist.put <- function(obj, key, value)
+# mdlist.*: functions for traversing a multi-dimensional list
+{
+ num.keys <- length(key)
+ if (0==num.keys)
+ {
+ stop("Argument \'key\' must have at least one element\n")
+ }
+ if (1==num.keys)
+ {
+ obj[[key]] <- value
+ return (obj)
+ }
+ if (1 < num.keys)
+ {
+ if (!mdlist.has(obj, key[1]))
+ {
+ obj[[ key[1] ]] <- list()
+ }
+ obj[[ key[1] ]] <- mdlist.put(obj[[key[1]]], key[-1], value)
+ }
+ obj
+}
diff --git a/R/WVmisc_stack.R b/R/WVmisc_stack.R
new file mode 100644
index 0000000..7efeb7b
--- /dev/null
+++ b/R/WVmisc_stack.R
@@ -0,0 +1,43 @@
+pop.back <- function(x)
+# returns the last element of the array, removing it in place
+{
+ r <- x[length(x)]
+ eval.parent(substitute(x<-x[-length(x)]))
+ return (r)
+}
+
+pop.front <- function(x)
+# returns the first element of the array, removing it in place
+{
+ r <- x[1]
+ eval.parent(substitute(x<-x[-1]))
+ return (r)
+}
+
+
+push.back <- function(x,y)
+# pushes y onto the back of array x
+{
+ if (is.list(x))
+ {
+ eval.parent(substitute(
+ x[[(length(x)+1)]]<-y
+ ))
+ }
+ else
+ {
+ eval.parent(substitute(
+ x[ (length(x)+1):(length(x)+length(y))]<-y
+ ))
+ }
+}
+
+push.front <- function(x,y)
+# pushes y onto the front of array x
+{
+ if (is.list(x))
+ {
+ stop("push.front() for list not yet implemented\n")
+ }
+ eval.parent(substitute(x<-c(y,x)))
+}
diff --git a/R/bagpipe_exception.R b/R/bagpipe_exception.R
new file mode 100644
index 0000000..8c91ac2
--- /dev/null
+++ b/R/bagpipe_exception.R
@@ -0,0 +1,13 @@
+bagpipe.data.error <- function(...){
+ stop("Bagpipe Data Error: ", ..., "\n", call.=FALSE)
+}
+
+bagpipe.proc.message <- function(...){
+ cat(..., "\n")
+}
+
+bagpipe.input.error <- function(...){
+ stop("Bagpipe Input Error: ", ..., "\n", call.=FALSE)
+}
+
+
diff --git a/R/bagpipe_formula.R b/R/bagpipe_formula.R
new file mode 100644
index 0000000..bfcca27
--- /dev/null
+++ b/R/bagpipe_formula.R
@@ -0,0 +1,425 @@
+bagpipe.formula.decipher <- function(string, extractor)
+{
+ pattern <- paste(
+ "[^0-9A-Za-z_\\.]", # not a variable, number or function
+ extractor,
+ sep="",
+# "\\(\\s*[0-9A-Za-z_\\.]+\\s*\\)")
+ "\\([^\\)]+\\)")
+ re.matches <- gregexpr(pattern, text=string, perl=TRUE)[[1]]
+
+ if (re.matches[1]==-1)
+ {
+ return(list(chunks=list(list(before=string)), after=""))
+ }
+ chunks <- list()
+ prev.end <- 0
+ for (i in 1:length(re.matches))
+ {
+ re.start <- re.matches[i]
+ re.end <- re.start + attr(re.matches, "match.length")[i] - 1
+ locus.cipher <- substring(string, re.start+1, re.end)
+ arg.string <- string.trim(gsub("\\)", "", gsub(".*\\(", "", locus.cipher)))
+ args <- unlist(strsplit(arg.string, split="\\s*,\\s*", perl=TRUE))
+ # first argument is assumed to be the locus name
+ locus.name <- args[1]
+
+ # subject arguments are options, and may be absent entirely
+ args <- args[-1]
+ arg.list=list()
+ for (a in args)
+ {
+ keyvalue=unlist(strsplit(split="\\s*=\\s*",a))
+ arg.list[[keyvalue[1]]] = keyvalue[2]
+ }
+
+ # unique tag for this cipher/argument combination
+ tag = paste(sep="-",locus.name,extractor,paste(collapse="-",args))
+ chunks[[i]] <- list(
+ before = substring(string, prev.end+1, re.start),
+ locus.cipher = locus.cipher,
+ locus.name = locus.name,
+ locus.args= arg.list,
+ predictor.tag=tag)
+ prev.end <- re.end
+ }
+ list(
+ chunks=chunks,
+ tail = substring(string, prev.end+1))
+}
+
+bagpipe.formula.encipher.locus <- function(marker, model)
+{
+ paste(bagpipe.formula.extractor.lookup(model=model), sep="", "(", marker, ")")
+}
+
+bagpipe.formula.extractor.lookup <- function(extractor=NULL, model=NULL)
+{
+ extractor.info <- list(
+ on.chrX=list(
+ tag="on.chrX",
+ happy.model=NA),
+ genotype = list(
+ tag="genotype",
+ happy.model="genotype"),
+ genotype.additive = list(
+ tag="genotype.additive",
+ happy.model="genotype.additive"),
+ genotype.hier = list(
+ tag="genotype.hier",
+ happy.model="genotype.hier"),
+ interval.additive = list(
+ tag="additive",
+ happy.model="additive"),
+ interval.dominance = list(
+ tag="dominance",
+ happy.model="dominance"),
+ interval.full = list(
+ tag="full",
+ happy.model="full"),
+ interval.fullasym = list(
+ tag="fullasym",
+ happy.model="fullasym"),
+ interval.prob.hom = list(
+ tag="prob.hom",
+ happy.model=NA),
+ interval.prob.het = list(
+ tag="prob.het",
+ happy.model=NA)
+ )
+
+ if (!is.null(extractor))
+ {
+ return (extractor.info[[extractor,exact=TRUE]])
+ }
+ extractor.table=data.frame(
+ extractor=names(extractor.info),
+ tag=sapply(extractor.info, function(x){x$tag}),
+ happy.model=sapply(extractor.info, function(x){x$happy.model}),
+ stringsAsFactors=FALSE)
+ if (!is.null(model))
+ {
+ return (extractor.table$extractor[match(model,extractor.table$happy.model)])
+ }
+ extractor.table
+}
+
+bagpipe.formula.reserved.variables <- function(h)
+{
+ c("THE.LOCUS", happy.get.strains(h))
+}
+
+bagpipe.formula.error <- function(...)
+{
+ stop("Bagpipe Formula Error: ", ..., "\n", call.=FALSE)
+}
+
+bagpipe.formula.has.abstract.loci <- function(x)
+{
+ "THE.LOCUS" %in% split.formula(x)$predictor.vars
+}
+
+bagpipe.get.design <- function(h, locus, extractor, extractor.args, extractor.tag, subjects)
+{
+ column.prefix=paste(locus,sep=".",extractor.tag)
+ sdp=NULL
+ if (list.has(extractor.args, "sdp"))
+ {
+ sdp=bagpipe.parse.sdp.string(h, extractor.args$sdp)
+ column.prefix=paste(column.prefix, sep="", ".sdp", extractor.args$sdp)
+ }
+
+ happy.model = bagpipe.formula.extractor.lookup(extractor)$happy.model
+ data=NULL
+
+ if (!is.na(happy.model))
+ {
+ data=happy.get.design(h,
+ marker=locus,
+ subjects=subjects,
+ model=happy.model,
+ sdp=sdp,
+ as.data.frame=FALSE)
+ if (1==ncol(data))
+ {
+ colnames(data) <- make.names(column.prefix)
+ }
+ else
+ {
+ colnames(data) <- make.names(paste(column.prefix,sep=".",colnames(data)))
+ }
+ }
+ else if ("on.chrX"==extractor)
+ {
+ chr=happy.get.chromosome(h, marker=locus)
+ data=matrix(as.numeric("X"==chr), nrow=length(subjects))
+ colnames(data)=column.prefix
+ }
+ else if ("interval.prob.het"==extractor)
+ {
+ if (length(extractor.args)!=0)
+ {
+ stop("Cannot currently handle arguments to interval.prob.het\n")
+ }
+ hd=happy.get.design(h, marker=locus, subjects=subjects,
+ model="dominance", as.data.frame=FALSE)
+ data=as.matrix(rowSums(hd))
+ colnames(data)=column.prefix
+ }
+ else if ("interval.prob.hom"==extractor)
+ {
+ if (length(extractor.args)!=0)
+ {
+ stop("Cannot currently handle arguments to interval.prob.hom\n")
+ }
+ hd=happy.get.design(h, marker=locus, subjects=subjects,
+ model="dominance", as.data.frame=FALSE)
+ data=1-as.matrix(rowSums(hd))
+ colnames(data)=column.prefix
+ }
+ else
+ {
+ bagpipe.formula.error(extractor, "() not implemented yet", "\n")
+ }
+ data
+}
+
+
+
+#------------------------
+# happy.genome compatible
+# ha == "happy all"
+
+bagpipe.expand.formula <- function( h,
+ formulae,
+ subjects = happy.get.subjects(h),
+ add.THE.LOCUS = FALSE,
+ minus.THE.LOCUS = FALSE,
+ THE.LOCUS = NULL,
+ THE.LOCUS.model = NULL,
+ dmat.transform.FUN = NULL,
+ verbose = FALSE)
+# Modelled after Richards private.substitute.locus() and parse.expanded.formula()
+# with differences:
+# 1) an arbitrary number of formulae can be passed to the function
+# 2) term expansion is bracketed where necessary, eg,
+# genotype:locus -> locus.<GENOTYPE.STRING>
+# additive:locus -> (locus.<STRAIN.1> + locus.<STRAIN.2> + ...)
+# Difference (2) corrects a flaw in private.substitute.locus() and
+# parse.expanded.formula() that resulted in incorrect expansion of
+# interaction terms like,eg:
+# additive:locus * GENDER -> locus.<STRAIN.1> + ...
+# + ... locus.<STRAIN.N-1> + locus.<STRAIN.N> * GENDER
+#
+# General info:
+#
+# Takes a text string and expands references to genotypes etc in it.
+# A reference of the form
+# genotype:rs12341
+# (where rs12341 is the name of a SNP) is found,
+# then the genotypes for that SNP are loaded as a covariate factor
+# and the formula modified to include the SNP.
+# Note that the SNP name must only contain alphanumeric characters plus "-" or "_" or "."
+# In particular is must not contain "+" or "*" or ":"
+# If the SNP name is not a legal R variable name it is converted using make.names()
+
+# Note that a reference to the genetic locus to be tested can be included as the string "THE.LOCUS"
+# If no such reference is found then it is added
+# This is not parsed in this function but is substituted later
+
+# In this way it is possible to encode interactions between the locus and covariates
+# e.g. GENDER*THE.LOCUS, GENDER:THE.LOCUS, genotype:rs3421 * THE.LOCUS
+# or additive:rs234234
+# or full:rs34234
+
+# It is important that no covariate name is a superstring of "THE.LOCUS"
+# It is important that spaces are included between the * and + in these models
+{
+ # check arguments
+ if (is.null(formulae) | 0==length(formulae))
+ {
+ stop("Formulae vector must be non-null and be of non-zero length\n")
+ }
+ if (!is.formula(formulae))
+ {
+ for (i in 1:length(formulae))
+ {
+ if (is.formula(formulae[i])) next
+
+ if (is.na(formulae[i]))
+ {
+ stop("Missing values in formulae[", i, "]\n")
+ }
+ }
+ }
+ formulae <- formula.as.string(formulae)
+ if (0==length(subjects))
+ {
+ warning("No subjects requested in bagpipe.expand.formula()!\n")
+ }
+ subjects <- as.character(subjects)
+
+ # incorporate THE.LOCUS
+ if (any(minus.THE.LOCUS))
+ {
+ if (length(minus.THE.LOCUS)!=length(formulae))
+ {
+ minus.THE.LOCUS = rep(minus.THE.LOCUS,
+ length.out=length(formulae))
+ }
+ formulae[minus.THE.LOCUS] <- drop.formula.vars(
+ formulae[minus.THE.LOCUS], "THE.LOCUS")
+ }
+ if (any(add.THE.LOCUS))
+ {
+ i <- setdiff(which(add.THE.LOCUS), grep("THE.LOCUS", formulae))
+ formulae[i] <- paste(formulae[i], " + THE.LOCUS", sep="")
+ }
+ if (!is.null(THE.LOCUS) & !is.null(THE.LOCUS.model))
+ {
+ THE.LOCUS.model <- rep(THE.LOCUS.model, length.out=length(formulae))
+ for (i in 1:length(formulae))
+ {
+ if (is.na(THE.LOCUS.model[i])) next
+ locus <- bagpipe.formula.encipher.locus(THE.LOCUS, THE.LOCUS.model[i])
+ formulae[i] <- gsub("THE.LOCUS", locus, formulae[i])
+ }
+ }
+ else if (!is.null(THE.LOCUS) & is.null(THE.LOCUS.model))
+ {
+ for (i in 1:length(formulae))
+ {
+ formulae[i] <- gsub("THE.LOCUS", THE.LOCUS, formulae[i])
+ }
+ }
+
+ # missing data
+ ok.subjects <- happy.has.subjects(h, subjects)
+
+ # expand formulae
+ seen.predictors <- list()
+ for (extractor in bagpipe.formula.extractor.lookup()$extractor)
+ {
+ for (i in 1:length(formulae))
+ {
+ form <- formulae[i]
+ deciphered <- bagpipe.formula.decipher(form, extractor=extractor)
+ new.formula <- ""
+
+ for (k in 1:length(deciphered$chunks))
+ {
+ chunk <- deciphered$chunks[[k]]
+ new.formula <- paste(new.formula, sep="", chunk$before)
+ locus.name <- chunk$locus.name
+ if (is.null(locus.name))
+ {
+ break
+ }
+
+ # if the locus is abstract, ignore it and go to the next specified locus
+ if ("THE.LOCUS"==locus.name)
+ {
+ new.formula <- paste(new.formula, sep="", chunk$locus.cipher)
+ next
+ }
+
+ # if the locus has been seen before, substitute in the saved terms.string
+ if (!is.null(seen.predictors[[chunk$predictor.tag, exact=TRUE]]))
+ {
+ new.formula <- paste(new.formula, sep=" ",
+ seen.predictors[[chunk$predictor.tag, exact=TRUE]]$terms.string)
+ next
+ }
+
+ # otherwise, create a terms.string and grab the necessary data
+ data <- bagpipe.get.design(h,
+ locus = chunk$locus.name,
+ subjects = subjects[ok.subjects],
+ extractor = extractor,
+ extractor.args = chunk$locus.args,
+ extractor.tag = bagpipe.formula.extractor.lookup(extractor)$tag)
+ if (is.nullOrEmpty(data))
+ {
+ if (is.null(data))
+ {
+ browser()
+ stop("Cannot find locus data for ", model,
+ ":",locus.name, " from formula ", form, "\n")
+ }
+ stop("Zero rows of locus data for requested ",
+ length(subjects), " subjects\n")
+ }
+ if (!is.null(dmat.transform.FUN) & 1<ncol(data))
+ # allow functions that modify the design matrix
+ # but ensure that colnames are still unique
+ {
+ data <- as.data.frame(dmat.transform.FUN(data))
+ if (0==length(grep(chunk$predictor.tag, colnames(data))))
+ {
+ colnames(data) <- paste(make.names(chunk$predictor.tag), sep=".",
+ colnames(data))
+ }
+ }
+ # record how this locus should appear in the formula
+ terms.string <- paste(colnames(data), collapse=" + ")
+ if (1<ncol(data))
+ {
+ terms.string <- paste("(",terms.string,")",sep="")
+ }
+ new.formula <- paste(new.formula, sep=" ", terms.string)
+
+ # cache
+ seen.predictors[[chunk$predictor.tag]] <- list(
+ terms.string = terms.string,
+ data = data)
+ }
+ formulae[i] <- paste(new.formula, sep="", deciphered$tail)
+ }
+ }
+
+ # cbind any locus data together
+ data <- NULL
+ if (0!=length(seen.predictors))
+ {
+ for (i in 1:length(seen.predictors))
+ {
+ if (is.null(data))
+ {
+ data <- seen.predictors[[i]]$data
+ }
+ else
+ {
+ # avoid using data frames to allow duplicate row.names
+ data <- cbind(data, seen.predictors[[i]]$data)
+ }
+ }
+ }
+
+ # pad out locus data with NA rows if necessary
+ if (!all(ok.subjects) & !is.null(data))
+ {
+ unpadded.data <- data
+ data <- matrix(
+ nrow=length(ok.subjects),
+ ncol=ncol(unpadded.data),
+ dimnames=list(NULL, colnames(unpadded.data)))
+ data <- as.data.frame(data) # this may need to be omitted when ncol=1
+ data[which(ok.subjects),] <- unpadded.data
+ }
+ list(formulae=formulae, locus.data=data)
+}
+
+bagpipe.parse.sdp.string <- function(h, sdp.string)
+{
+ SPLIT.TOKEN="."
+ num.founders=happy.num.strains(h)
+ token=ifow(igrep(pattern=SPLIT.TOKEN, sdp.string, fixed=TRUE), SPLIT.TOKEN, "")
+ sdp.symbols=unlist(strsplit(sdp.string, split=token, fixed=TRUE))
+
+ if(length(sdp.symbols)!=num.founders)
+ {
+ bagpipe.formula.error("SDP must specify grouping for ", num.founders, " founders, but '",sdp.string,"' implies ", length(sdp.symbols), " founders")
+ }
+ sdp.symbols
+}
+
diff --git a/R/bagpipe_genome_scan.R b/R/bagpipe_genome_scan.R
new file mode 100755
index 0000000..cfbdfb7
--- /dev/null
+++ b/R/bagpipe_genome_scan.R
@@ -0,0 +1,825 @@
+DEFAULT.REDUCE.DMAT.CUTOFF <- 0.01
+
+as.DiploprobReader <- function(h){
+ if (inherits(h, "happy.genome")){
+ return (DiploprobReader$new(h))
+ } else if (inherits(h, "DiploprobReader")) {
+ return (h)
+ } else {
+ stop("as.DiploprobReader conversion failed for object of class ", paste("{", paste(collapse=",", class(h)), "}"))
+ }
+}
+
+bagpipe.extract.loci <- function(h, locus.group.id){
+ h <- as.DiploprobReader(h)
+ loci <- NULL
+ if (locus.group.id %in% h$getChromList()) {
+ loci <- h$getLoci(chrom=locus.group.id)
+ } else if (file.exists(locus.group.id)){
+ loci <- scan(locus.group.id, comment.char="#", blank.lines.skip=TRUE, what="character")
+ if (!all(h$hasLoci(loci))){
+ bagpipe.input.error("Input error: could not find loci ", paste(sep=",", loci[!has.loci]), "listed in file", locus.group.id, "\n")
+ }
+ } else {
+ bagpipe.input.error("Config field ", locus.group.id, " must correspond to either a chromosome or a filename.")
+ }
+ loci
+}
+
+bagpipe.extract.subjects <- function(h, subjects.spec){
+ MIN.NUM.SUBJECTS <- 10
+ h <- as.DiploprobReader(h)
+ if (1!=length(subjects.spec)){
+ bagpipe.input.error("Not implemented yet: multiple arguments for subjects in config.")
+ }
+
+ subjects <- NULL
+ if ("ALL"==subjects.spec){
+ subjects <- h$getSubjects()
+ } else if (file.exists(subjects.spec)){
+ subjects <- scan(subjects.spec, comment.char="#", blank.lines.skip=TRUE, what="character")
+ subjects <- intersect(subjects, h$getSubjects())
+ if (MIN.NUM.SUBJECTS>=length(subjects)){
+ bagpipe.input.error("Input error: fewer than ", MIN.NUM.SUBJECTS, " subjects specified by config file have genotype information.")
+ }
+ } else {
+ bagpipe.input.error("Unsupported subject specifcation: ", subjects.string)
+ }
+ subjects
+}
+
+bagpipe.read.configfile <- function(config.file){
+ config <- read.configfile(config.file)
+ for (filespec in c("genome.cache.dir", "phenotype.file")){
+ if (!configfile.has(config, filespec)) next
+ pathname <- configfile.string(config, filespec)
+ config[[filespec]] <- interpolate.Sys.env(pathname)
+ }
+ config
+}
+
+
+make.reduce.dmat.fun <- function(config.string)
+# Make function to reduce the dimensionality of the design matrix
+{
+ if ("FALSE"==config.string)
+ {
+ return (NULL)
+ }
+
+ cutoff <- NULL
+ if ("TRUE"==config.string)
+ {
+ cutoff <- DEFAULT.REDUCE.DMAT.CUTOFF
+ }
+ else
+ {
+ cutoff <- try(as.numeric(config.string))
+ if (caught.error(cutoff))
+ {
+ bagpipe.input.error("reduce.dmat option must be TRUE, FALSE or a real positive number\n")
+ }
+ cutoff <- abs(cutoff)
+ }
+ return ( function(x) { reduce.dim(x, sdev.cutoff=cutoff ) } )
+}
+
+#--------------------------------------------------------------------------
+# GENERAL SCAN FUNCTIONS
+#
+
+get.phenotype.data <- function(h, config, warn = 1)
+{
+ MIN.DATA.SIZE <- 5
+ MIN.Y.RANGE <- 0.01
+ MAX.Y.RANGE <- 1e7
+
+ phenotype <- configfile.string(config, "analysis.id")
+ subjects <- bagpipe.extract.subjects(h, configfile.strings(config, "subjects", default="ALL"))
+
+ #----------------------------
+ # Set up phenotype data frame
+
+ # read phenotype
+ phenoFile <- configfile.string(config, "phenotype.file")
+ if (!file.exists(phenoFile)) {
+ bagpipe.input.error("Could not open ", phenoFile)
+ }
+ data <- read.delim(phenoFile)
+ cat("Reading ", phenoFile, "\n")
+
+ # get rid of purely null strings
+ data[ data=="" ] <- NA
+
+ # filter and sort to match happy subjects
+ if (is.null(data$SUBJECT.NAME)) {
+ bagpipe.input.error("Phenotype file must have column SUBJECT.NAME\n")
+ }
+ data <- data[match(subjects, data$SUBJECT.NAME),]
+
+ # apply subsetting
+ if (configfile.has(config, "data.subset")) {
+ s <- configfile.get(config, "data.subset")
+ i <- try(eval(parse(text=s), env=data))
+ if (caught.error(i)) {
+ bagpipe.input.error("Could not process data.subset argument:", i)
+ }
+ i <- force.logical(i, na=FALSE)
+ if (MIN.DATA.SIZE > sum(i)){
+ bagpipe.data.error("Data subset ", s, " contains only ",
+ sum(i), " data points!\n")
+ }
+ data <- data[i,]
+ }
+
+ # formulae
+ model.formulae <- list(
+ scan.formula.null = configfile.string(config, "scan.formula.null"),
+ scan.formula.test = configfile.string(config, "scan.formula.test"),
+ nullsim.formula = configfile.string(config, "nullsim.formula",
+ default=configfile.string(config, "scan.formula.null")),
+ rma.formula = configfile.string(config, "rma.formula",
+ default = configfile.string(config, "scan.formula.null"))
+ )
+ present.formulae <- which(!is.na(unlist(model.formulae)))
+
+ # simplify 1D responses by transformation
+ for (i in 1:length(model.formulae)) {
+ if (is.na(model.formulae[[i]])) next
+
+ spf <- split.formula(model.formulae[[i]])
+ if (1!=length(spf$response)) next
+ if (spf$response==spf$response.vars) next
+
+ new.response.name <- paste("transformed.",sep="", make.names(spf$response))
+ model.formulae[[i]] <- paste(new.response.name, sep=" ~ ", spf$predictor.string)
+ if (new.response.name %in% colnames(data)) next
+
+ data[,new.response.name] = apply.transform(spf$response, data)
+
+ # Check range of data is within sensible limits
+ y.range=diff(range(apply.transform(model.formulae[[i]], data=data), na.rm=TRUE))
+ if (y.range < MIN.Y.RANGE || y.range > MAX.Y.RANGE) {
+ bagpipe.input.error("Phenotype has bad range. Difference between mininum and maximum of (transformed) phenotype value must be with the range [", MIN.Y.RANGE, ", ", MAX.Y.RANGE, "], otherwise model fitting procedures can be unstable.")
+ }
+ }
+
+ # model functions
+ model.functions <- list(
+ scan.function = unify.generic.model.type(configfile.string(
+ config, "scan.function")),
+ nullsim.function = unify.generic.model.type(configfile.string(
+ config, "nullsim.function",
+ default=configfile.string(config, "scan.function"))),
+ rma.function = unify.generic.model.type(configfile.string(
+ config, "rma.function",
+ default=configfile.string(config, "scan.function")))
+ )
+
+ # survival data : TODO!!!
+ if (any("survival" %in% unlist(model.functions)))
+ {
+ bagpipe.input.error("Cannot currently handle survival data\n")
+ # clean up survival data
+ if ("survival"==configfile.string(config, "scan.function"))
+ {
+ y <- apply.transform(split.formula(subformula)$response, data)
+ if ((nzero <- sum(y[,1] <= 0, na.rm=TRUE))>0)
+ {
+ browser()
+ stop("Time to event data must have all times > 0\n")
+ }
+ }
+ }
+
+ # define some quick closures to help parse model options
+ quick.configfile.function.options <- function(key)
+ {
+ if (!configfile.has(config, key))
+ {
+ return (list(dmat=NULL, others=list()))
+ }
+ arg.list <- eval(parse(text=paste("list(",
+ configfile.string(config,key),")")) )
+ #,
+ #env=pdata)
+ dmat <- NULL
+ if (list.has(arg.list, "reduce.dmat"))
+ {
+ dmat <- make.reduce.dmat.fun(arg.list$reduce.dmat)
+ arg.list$reduce.dmat <- NULL
+ }
+ return (list(dmat=dmat, others=arg.list))
+ }
+ quick.get.dmat <- function(x){quick.configfile.function.options(x)$dmat}
+ quick.get.args <- function(x){quick.configfile.function.options(x)$others}
+
+ # incorporate any locus information
+ if (!is.null(h))
+ {
+ expanded <- bagpipe.expand.formula(
+ h,
+ formulae = unlist(model.formulae)[present.formulae],
+ subjects = data$SUBJECT.NAME,
+ dmat.transform.FUN = quick.get.dmat("scan.function.options"))
+ for (i in 1:length(present.formulae))
+ {
+ model.formulae[[present.formulae[i]]] <- expanded$formulae[i]
+ }
+ if (!is.null(expanded$locus.data))
+ {
+ data <- cbind(data, expanded$locus.data)
+ }
+ }
+
+ # subject weights
+ weights.formula = configfile.get(config, "subject.weighting", default="~1")
+
+ # collate model options
+ scan.options <- list(
+ null.formula = model.formulae$scan.formula.null,
+ test.formula = model.formulae$scan.formula.test,
+ fitting.family = model.functions$scan.function,
+ fitting.args = quick.get.args("scan.function.options"),
+ reduce.dmat = quick.get.dmat("scan.function.options"),
+ weights.formula = weights.formula
+ )
+ nullsim.options <- list(
+ null.formula = model.formulae$nullsim.formula,
+ fitting.family = model.functions$nullsim.function,
+ fitting.args = quick.get.args("nullsim.model.function.options"),
+ reduce.dmat = quick.get.dmat("nullsim.model.function.options"),
+ weights.formula = weights.formula
+ )
+ rma.options <- list(
+ null.formula = model.formulae$rma.formula.null,
+ fitting.family = model.functions$rma.model.function,
+ fitting.args = quick.get.args("rma.function.options"),
+ reduce.dmat = quick.get.dmat("rma.function.options"),
+ weights.formula = weights.formula
+ )
+
+ # prepare sub-data frame pdata with all covariates and responses
+ all.responses <- unique(unlist(
+ lapply( model.formulae,
+ function(x){split.formula(unlist(x))$response.vars})
+ ))
+ all.covariates <- unique(unlist(
+ lapply( c(model.formulae, weights.formula),
+ function(x){split.formula(unlist(x))$predictor.vars})
+ ))
+ all.covariates <- setdiff(all.covariates,
+ bagpipe.formula.reserved.variables(h))
+
+ all.cols <- c( "SUBJECT.NAME", unique(c(all.covariates, all.responses)))
+ if (!all(all.cols %in% colnames(data)))
+ {
+ bagpipe.input.error("Variables in model formulae for ", phenotype,
+ " are missing from ", phenoFile, ": ",
+ paste(setdiff(all.cols, colnames(data)), collapse=", "),
+ "\n")
+ }
+ pdata <- data[,c("SUBJECT.NAME", all.responses, all.covariates)]
+ pdata <- pdata[complete.cases(pdata),]
+ if (0==nrow(pdata))
+ {
+ bagpipe.data.error("There are no complete cases for phenotype ",
+ phenotype)
+ }
+
+ # compile return value
+ retval <- list(
+ file = phenoFile,
+ all.data = data,
+ pdata = pdata,
+ scan.options = scan.options,
+ nullsim.options = nullsim.options,
+ rma.options = rma.options,
+ phenotype = phenotype,
+ response.names = all.responses,
+ covariates = all.covariates
+ )
+ retval
+}
+
+general.scan <- function(h,
+ null.formula,
+ test.formula,
+ markers,
+ data,
+ model.type,
+ weights.formula,
+ weights.factor = NULL,
+ model.args = list(),
+ verbose = TRUE,
+ reduce.dmat = NULL,
+ save.at.loci= NULL)
+{
+ if (bagpipe.formula.has.abstract.loci(null.formula)){
+ # using constant null model works only if null model does not
+ # contain THE.LOCUS
+ constant.null.model = FALSE
+ }
+
+ # set up data frame to hold the the results
+ num.loci <- length(markers)
+ results <- data.frame(
+ locus = I(markers),
+ chr = happy.get.chromosome(h, markers),
+ cM = happy.get.location(h, markers, scale="cM"),
+ bp = happy.get.location(h, markers, scale="bp"),
+ num.obs = rep(nrow(data), num.loci),
+ null.logLik = rep(NA, num.loci),
+ null.num.params = rep(NA, num.loci),
+ test.logLik = rep(NA, num.loci),
+ test.num.params = rep(NA, num.loci),
+ LOD = rep(NA, num.loci),
+ modelcmp = rep(NA, num.loci),
+ comments = rep(NA, num.loci)
+ )
+
+ if (verbose) {cat("general.scan() of", num.loci, "markers:")}
+
+ for( i in 1:num.loci){
+ locus <- markers[i]
+ if (verbose) {cat("[",i,"]",sep="")}
+
+ #------------------------------------------------
+ # expand formulae and extract locus specific data
+ #------------------------------------------------
+ expanded <- bagpipe.expand.formula(h,
+ formulae = c(null.formula,test.formula, weights.formula),
+ THE.LOCUS = locus,
+ subjects = data$SUBJECT.NAME,
+ dmat.transform.FUN = reduce.dmat)
+
+ gdata <- cbind(data, expanded$locus.data)
+
+ # interpret weights
+ # TODO: weights should be in the definition of the PCs in expand.formula
+ weights <- ifow(
+ is.null(split.formula(weights.formula)$predictors),
+ rep(1,nrow(gdata)),
+ eval(parse(text=split.formula(expanded$formulae[3])$predictor.string), env=gdata))
+ if (!is.null(weights.factor)){
+ if (1==length(weights.factor) | length(weights)==length(weights.factor)){
+ weights <- weights * weights.factor
+ } else {
+ stop("Incorrectly specified weights.factor:", weights.factor, "\n")
+ }
+ }
+ # remove zero weight obs, because fitting functions can't handle this
+ nonzero.weight.obs <- 0 < weights # could add a tolerance
+ gdata <- gdata[nonzero.weight.obs, ]
+ weights <- weights[nonzero.weight.obs]
+ results$num.obs[i] = sum(weights)
+ args=c(model.args, list(weights=weights))
+
+ #---------------
+ # fit models
+ #---------------
+ # ensure false convergences result in NA values
+ oldwarn <- options("warn")
+ options(warn=2)
+ fit0 <- try(unify.fit(
+ as.formula(expanded$formulae[1]),
+ data = gdata,
+ model.type = model.type,
+ args = args))
+ options(oldwarn)
+ if (caught.error(fit0))
+ {
+ warning(paste("Warning: could not fit null model for ",locus),"\n")
+ next
+ }
+ results$null.logLik[i] <- unify.logLik(fit0)
+ results$null.num.params[i] <- unify.num.params(fit0)
+
+ options(warn=2)
+ fit1 <- try(unify.fit(
+ as.formula(expanded$formulae[2]),
+ data = gdata,
+ model.type = model.type,
+ args = args))
+ options(oldwarn)
+ if (caught.error(fit1))
+ {
+ warning(paste("Warning: could not fit alternative model for ",locus),"\n")
+ next
+ }
+
+ results$test.logLik[i] <- unify.logLik(fit1)
+ results$test.num.params[i] <- unify.num.params(fit1)
+
+ options(oldwarn)
+ #------------------------
+ # save fits, if requested
+ #------------------------
+ if (!is.null(save.at.loci))
+ {
+ if (locus %in% names(save.at.loci))
+ {
+ save(fit0, fit1, file=save.at.loci[[locus,exact=TRUE]])
+ }
+ }
+
+ #---------------------
+ # inference for models
+ #---------------------
+
+ results$LOD[i] <- (results$test.logLik[i] - results$null.logLik[i])/log(10)
+
+ an <- unify.anova.list(fit0, fit1)
+ if (!is.finite(an$logP[2]))
+ {
+ an$logP[2] <- NA # Inf is typically a mistake
+ }
+ results$modelcmp[i] <- an$logP[2]
+ }
+ if (verbose){cat("Done\n")}
+
+ return(list(
+ null.formula = null.formula,
+ test.formulae = test.formula,
+ table = results,
+ model = model.type,
+ anova = NA,
+ modelcmp.type = "logP"
+ ))
+}
+
+Bagpipe.ReadScanFile <- function(file, update.bp=FALSE, dr=NULL){
+ # gives scan file in a list
+ text <- readLines(file)
+
+ # read scan data
+ start <- grep("^BEGIN_SCAN_DATA", text) + 1
+ end <- grep("^END_SCAN_DATA", text) - 1
+ if (length(start)!=1 | length(end)!=1){
+ stop("Cannot read scan file", file, "\n")
+ }
+ textCon <- textConnection(text[start:end])
+ scan.data <- cols.as(read.delim(textCon),
+ list(locus="character", chr="character"))
+ close(textCon)
+ if (update.bp){ # update bp info
+ stopifnot(!is.null(dr) & inherits(dr, "DiploprobReader"))
+ scan.data$bp <- dr$getMarkerLocation(scan.data$locus, scale="bp")
+ }
+ out <- list(scan.data=scan.data)
+
+ # read anova data
+ start <- grep("^BEGIN_ANOVA", text) + 1
+ end <- grep("^END_ANOVA", text) - 1
+ if ((length(start)==1 | length(end)==1) & force.logical(end - start)){
+ textCon <- textConnection(text[start:end])
+ out$anova <- try(read.delim(textCon))
+ close(textCon)
+ }
+
+ # get other stuff
+ wanted <- c("phenotype", "build", "chromosome", "formula")
+ for (w in wanted){
+ pattern <- paste("^", toupper(w), sep="")
+ out[[w]] <- string.trim(
+ sub(pattern,"",grep(pattern, text, value=T)))
+ }
+ out
+}
+
+read.scan.file <- function(file){
+ Bagpipe.ReadScanFile(file)
+}
+
+scan.phenotype <- function(h,
+ config,
+ markers,
+ scan.type,
+ cpus = 1,
+ verbose = FALSE,
+ seed = 1,
+ data.object = NULL,
+ save.at.loci= NULL)
+{
+ pheno <- configfile.string(config, "analysis.id")
+
+ #---------------------------------
+ # Get phenotype and covariate data
+ #---------------------------------
+ if (is.null(data.object)){
+ d <- get.phenotype.data(h, config=config)
+ } else {
+ d <- data.object
+ }
+
+ #------
+ # Scans
+ #------
+ result <- NULL
+ if ("scan"==scan.type) {
+ result <- general.scan(h,
+ data = d$pdata,
+ markers = markers,
+ null.formula = d$scan.options$null.formula,
+ test.formula = d$scan.options$test.formula,
+ reduce.dmat = d$scan.options$reduce.dmat,
+ model.type = d$scan.options$fitting.family,
+ model.args = d$scan.options$fitting.args,
+ weights.formula = d$scan.options$weights.formula,
+ weights.factor = d$scan.options$weights.factor,
+ save.at.loci = save.at.loci,
+ verbose = verbose)
+ }
+ else if (scan.type %in%
+ c("permute.scan", "nullsim.scan", "nullsimpermute.scan", "nullfile.scan")) {
+ num.nullscans <- configfile.integer(config, "num.nullscans")
+ nullscan.seed <- configfile.integer(config, "nullscan.seed")
+
+ fake.responses <- NULL
+ if ("permute.scan"==scan.type){
+ if (!is.null(split.formula(d$scan.options$null.formula)$predictors)){
+ stop("Permutation with covariates is currently unavailable\n")
+ }
+
+ fake.responses <- make.permuted.responses(h,
+ null.formula=d$scan.options$null.formula,
+ num.perms=num.nullscans,
+ data=d$pdata,
+ seed=nullscan.seed)
+ }
+ else if ("nullsim.scan"==scan.type){
+ fake.responses <- make.parboot.responses(h,
+ null.formula=d$nullsim.options$null.formula,
+ num.responses=num.nullscans,
+ data=d$pdata,
+ seed=nullscan.seed,
+ model.type=d$nullsim.options$fitting.family,
+ model.args=d$nullsim.options$fitting.args)
+ }
+ else if ("nullsimpermute.scan"==scan.type){
+ fake.responses <- make.parboot.permuted.responses(h,
+ null.formula=d$nullsim.options$null.formula,
+ num.responses=num.nullscans,
+ data=d$pdata,
+ seed=nullscan.seed,
+ model.type=d$scan.options$fitting.family,
+ model.args=d$scan.options$fitting.args)
+ }
+ else if ("nullfile.scan"==scan.type){
+ null.file <- configfile.string(config, "nullscan.phenotype.file")
+ fake.responses <- read.nullphenotype.file(null.file, ref.data=d$pdata, num.required=num.nullscans)
+ }
+ # univariate only:
+ # nullphen.data <- cbind(d$pdata$SUBJECT.NAME, as.data.frame(sapply(fake.responses, function(d){d[,1]})))
+ # colnames(nullphen.data)[1] <- "SUBJECT.NAME"
+ # write.csv(file="nullphenotype.csv", nullphen.data, row.names=FALSE)
+ saveRDS(fake.responses, file=paste0(pheno, ".", scan.type, ".", "nullphenotypes.RDS"))
+
+ if ("gaussian"==d$scan.options$fitting.family
+ & !unify.is.multilevel.formula(d$scan.options$null.formula)
+ & !unify.is.multilevel.formula(d$scan.options$test.formula)){
+ fake.response.matrix <- sapply(fake.responses$responses.list, function(x) as.matrix(x))
+ result <- lm.multiscan(h,
+ response.matrix = fake.response.matrix,
+ data = d$pdata,
+ markers = markers,
+ null.formula = d$scan.options$null.formula,
+ test.formula = d$scan.options$test.formula,
+ scan.function.args = d$scan.options$fitting.args,
+ weights.formula = d$scan.options$weights.formula,
+ verbose = TRUE )
+ }
+ else{
+ result <- general.multiscan(h,
+ responses = fake.responses$responses.list,
+ data = d$pdata,
+ markers = markers,
+ null.formula = d$scan.options$null.formula,
+ test.formula = d$scan.options$test.formula,
+ scan.function.args = d$scan.options$fitting.args,
+ reduce.dmat = d$scan.options$reduce.dmat,
+ model.type = d$scan.options$fitting.family,
+ model.args = d$scan.options$fitting.args,
+ weights.formula = d$scan.options$weights.formula,
+ cpus = cpus,
+ verbose = TRUE )
+ }
+ }
+ result
+}
+
+write.multiscan.max <- function(results, file){
+ # record max information
+ best.LOD <- apply(results$scores.LOD, 2, max, na.rm=TRUE)
+ best.modelcmp <- apply(results$scores.modelcmp, 2, max, na.rm=TRUE)
+
+ out.data <- data.frame(
+ scan.number = results$response.number,
+ best.LOD = best.LOD,
+ best.modelcmp = best.modelcmp)
+ write.delim(out.data, file=file)
+}
+
+write.scan <- function ( scan, filename){
+ file <- file(filename, open="wt")
+ scan$table$modelcmp.type <- scan$modelcmp.type
+
+ cat(file=file, "SCAN_RESULTS ", scan$date , "\n" )
+ cat(file=file, "PHENOTYPE ", scan$phenotype, "\n")
+ cat(file=file, "POPULATION ", scan$population, "\n")
+ cat(file=file, "BUILD ", scan$build, "\n")
+ cat(file=file, "CHROMOSOME ", scan$chromosome, "\n")
+ cat(file=file, "NULL.FORMULA ", scan$null.formula, "\n")
+ cat(file=file, "TEST.FORMULA ", scan$test.formula, "\n")
+ cat(file=file, "PHASE ", scan$phase, "\n" )
+ cat(file=file, "BEGIN_SCAN_DATA\n")
+ write.delim(file=file, scan$table )
+ cat(file=file, "END_SCAN_DATA\n")
+ close(file)
+}
+
+do.scan <- function(
+ h,
+ config,
+ cpus=1,
+ loci,
+ output.dir = "./",
+ output.file = NULL,
+ phenotype,
+ scan.type,
+ verbose=FALSE,
+ save.at.loci=NULL)
+{
+ phenotype <- configfile.get(config, "analysis.id")
+ #--------------------
+ # Set up output files
+ #--------------------
+
+ if (!is.null(output.file)){
+ output.file <- file.path(output.dir, output.file)
+ if (!file.exists(output.dir)){
+ stop("Directory", output.dir, "does not exist\n")
+ }
+ }
+
+ result <- scan.phenotype(h,
+ config = config,
+ markers = loci,
+ scan.type = scan.type,
+ verbose = verbose,
+ cpus = cpus,
+ save.at.loci=save.at.loci)
+
+ if (is.null(result)){
+ stop("No results for analysis id ", phenotype, "\n")
+ next
+ }
+ #--------------------
+ # Write results files
+ #--------------------
+ if (!is.null(output.file)){
+ if ("scan"==scan.type){
+ result$phenotype <- phenotype
+ result$date <- date()
+ result$chromosome <- paste(sep=",", unique(happy.get.chromosome(h, loci)))
+ result$build <- configfile.string(config, "build",
+ stop.on.fail=FALSE, default="UnknownBuild")
+ result$population <- configfile.string(config, "population",
+ stop.on.fail=FALSE, default="UnknownPopulation")
+ result$phase <- configfile.string(config, "phase",
+ stop.on.fail=FALSE, default="UnknownPhase")
+ result$genetic.model <- "happy"
+
+ write.scan(result, output.file)
+ }
+ if (scan.type %in% c("permute.scan", "nullsim.scan", "nullsimpermute.scan", "nullfile.scan")) {
+ write.multiscan.max( result, file=output.file )
+ }
+ }
+ invisible(result)
+}
+
+
+general.multiscan <- function(h,
+ responses.list,
+ data,
+ markers,
+ null.formula,
+ test.formula,
+ scan.function.args,
+ reduce.dmat,
+ model.type,
+ model.args,
+ weights.formula,
+ cpus=1,
+ verbose = TRUE )
+{
+ num.loci <- length(markers)
+ num.responses <- length(responses.list)
+ response.names <- split.formula(null.formula)$response.vars
+ if (verbose) cat("scanning multiple phenotypes: ")
+
+ per.scan=function(s)
+ {
+ cat("\n[starting scan ",sep="",s,"/",num.responses,"]\n")
+ responses.list[[s]]
+ sim.data <- data
+ sim.data[, response.names ] <- responses.list[[s]]
+
+ result.list <- general.scan(h,
+ null.formula = null.formula,
+ test.formula = test.formula,
+ markers = markers,
+ data = sim.data,
+ model.type = model.type,
+ model.args = model.args,
+ weights.formula = weights.formula,
+ verbose = verbose,
+ reduce.dmat = reduce.dmat)
+ result <- result.list$table
+
+ list(
+ LOD=result$LOD,
+ modelcmp=result$modelcmp,
+ modelcmp.type=result.list$modelcmp.type
+ )
+ }
+
+ results=NULL
+ if (cpus>1)
+ {
+ require(multicore)
+ results = mclapply(1:num.responses, per.scan)
+ }
+ else
+ {
+ results = lapply(1:num.responses, per.scan)
+ }
+ scores.LOD = sapply(results, function(x){x$LOD})
+ scores.modelcmp = sapply(results, function(x){x$modelcmp})
+ if (verbose) cat("\n")
+
+ list(
+ modelcmp.type = results[[1]]$modelcmp.type, # inelegant.
+ response.number = 1:num.responses,
+ scores.modelcmp=scores.modelcmp,
+ scores.LOD=scores.LOD)
+}
+
+lm.multiscan <- function(h,
+ response.matrix,
+ markers,
+ null.formula,
+ test.formula,
+ weights.formula,
+ data,
+ scan.function.args=list(),
+ verbose=TRUE)
+{
+ if (bagpipe.formula.has.abstract.loci(null.formula)) {
+ stop("Currently cannot do permutation with abstract loci in the null model\n")
+ }
+ num.loci <- length(markers)
+ num.responses <- ncol(response.matrix)
+ scores.LOD <- matrix(nrow=num.loci, ncol=num.responses)
+ scores.modelcmp <- matrix(nrow=num.loci, ncol=num.responses)
+ if (verbose) cat("scanning multiple phenotypes for marker ")
+ for(m in 1:num.loci){
+ if (verbose) cat("[", m, "]", sep="")
+ marker <- markers[m]
+ expanded <- bagpipe.expand.formula(h,
+ formulae = c(null.formula, test.formula, weights.formula),
+ subjects = data$SUBJECT.NAME,
+ THE.LOCUS = marker)
+ gdata = cbind(data, expanded$locus.data)
+
+ # interpret weights
+ weights = ifow(
+ is.null(split.formula(weights.formula)$predictors),
+ rep(1,nrow(gdata)),
+ eval(parse(text=split.formula(expanded$formulae[3])$predictor.string),
+ env=gdata))
+
+ marker.results <- lm.multiresponse(
+ formula = expanded$formulae[2],
+ response.matrix = response.matrix,
+ data = gdata,
+ null.formula = expanded$formulae[1],
+ logP = TRUE,
+ LOD = TRUE,
+ weights = weights,
+ model.args = scan.function.args)
+
+ if (is.null(marker.results)) next
+
+ scores.modelcmp[m,] <- marker.results$logP
+ scores.LOD[m,] <- marker.results$LOD
+ }
+ if (verbose) cat("\n")
+
+ list( modelcmp.type = "logP",
+ response.number=1:num.responses,
+ scores.modelcmp=scores.modelcmp,
+ scores.LOD=scores.LOD)
+}
+
diff --git a/R/bagpipe_happy_graphics.R b/R/bagpipe_happy_graphics.R
new file mode 100755
index 0000000..4c08cac
--- /dev/null
+++ b/R/bagpipe_happy_graphics.R
@@ -0,0 +1,550 @@
+
+
+happy.get.genome.location <- function(h, markers=NULL, chr=NULL, bp=0,
+ pretty = TRUE,
+ pad.bp = ifelse(pretty, 2e7, 0),
+ pad.position = ifelse(pretty, 10, 0))
+{
+ # calculate chromosome offsets
+ all.markers <- happy.get.markers(h)
+ all.chroms <- happy.get.chromosome(h, all.markers)
+ all.pos <- happy.get.position(h, all.markers)
+ all.bp <- happy.get.bp(h, all.markers)
+
+ chroms <- happy.list.chromosomes(h)
+ last.pos <- 0
+ last.bp <- 0
+ chrom2add <- data.frame(
+ rownames=chroms,
+ pos=rep(0, length(chroms)),
+ bp=rep(0, length(chroms)))
+
+ chrom2addpos <- list()
+ chrom2addbp <- list()
+
+ first.marker <- happy.get.markers(h, chr=chroms[1])[1]
+
+ chrom2addpos[[chroms[1]]] <- - happy.get.position(h, first.marker)
+ chrom2addbp[[chroms[1]]] <- - happy.get.bp(h, first.marker)
+
+ for (i in 2:length(chroms))
+ {
+ first.marker <- happy.get.markers(h, chr=chroms[i])[1]
+
+ prev.chr.length <- happy.get.chromosome.length(h, chroms[i-1],
+ scale="cM",
+ subtract.offset=FALSE)
+ curr.offset <- happy.get.position(h, first.marker)
+ chrom2addpos[[chroms[i]]]<- chrom2addpos[[chroms[i-1]]] +
+ prev.chr.length - curr.offset + pad.position
+
+ prev.chr.length <- happy.get.chromosome.length(h, chroms[i-1],
+ scale="bp", subtract.offset=FALSE)
+ curr.offset <- happy.get.bp(h, first.marker)
+ chrom2addbp[[chroms[i]]]<- chrom2addbp[[chroms[i-1]]] +
+ prev.chr.length - curr.offset + pad.bp
+ }
+
+ #
+
+ if (!is.null(markers))
+ {
+ marker.chr <- happy.get.chromosome(h, markers)
+ marker.pos <- happy.get.position(h, markers) + as.numeric(chrom2addpos[marker.chr])
+ marker.bp <- happy.get.bp(h, markers) + as.numeric(chrom2addbp[marker.chr])
+
+ return (data.frame(position=marker.pos, bp=marker.bp, marker=as.character(markers)))
+ }
+ else if (!is.null(bp) & !is.null(chr))
+ {
+ chr <- as.character(chr)
+ if (length(chr)!=length(bp))
+ {
+ if (1==length(chr) & 1 < length(bp)) chr <- rep(chr, length(bp))
+ else if (1<length(chr) & 1==length(bp)) bp <- rep(bp, length(chr))
+ else
+ {
+ stop("Incompatible bp and chr arguments: chr(",
+ paste(collapse=",", chr), "), bp(",
+ paste(collapse=",", bp), ")")
+ }
+ }
+ return (as.numeric(chrom2addbp[chr]) + bp)
+ }
+}
+
+happy.make.genome.location <- function(h,
+ markers = NULL,
+ chr = NULL,
+ x = NULL,
+ pretty = TRUE,
+ scale = "cM",
+ pad = switch(scale,
+ cM = ifelse(pretty, 10, 0),
+ bp = ifelse(pretty, 2e7, 0),
+ Mb = ifelse(pretty, 20, 0)
+ )
+ )
+{
+ # calculate chromosome offsets
+ chroms <- happy.list.chromosomes(h)
+ first.markers <- happy.get.first.marker(h, chroms)
+ chrom.offset <- rep(0, length(chroms))
+ chrom.offset[1] <- happy.get.location(h, first.markers[1], scale=scale)
+
+ for (i in 2:length(chroms))
+ {
+ prev.chr.length <- happy.get.chromosome.length(h, chroms[i-1],
+ scale=scale,
+ subtract.offset=FALSE)
+ offset <- happy.get.location(h, first.markers[i], scale=scale)
+ cat("Chr ", i, "offset", offset, "\n")
+ chrom.offset[i] <- chrom.offset[i-1] + prev.chr.length - offset + pad
+ }
+
+ chrmap = data.frame(
+ chr = I(chroms),
+ offset = chrom.offset)
+ chrmap$start <- chrom.offset + happy.get.location(h, first.markers, scale=scale)
+ chrmap$end <- chrom.offset + happy.get.chromosome.length(h, chroms, scale=scale)
+ chrmap$midpoint <- 0.5 * (chrmap$start + chrmap$end)
+
+ retval <- list(chr.limits=chrmap)
+
+ # calculate specific positions
+ if (!is.null(x) & !is.null(chr))
+ {
+ stopifnot(length(x)==length(chr))
+ x <- x + chrmap$offset[match(chr, chrmap$chr)]
+ retval$x <- x
+ }
+ if (!is.null(markers))
+ {
+ marker.chr <- happy.get.chromosome(h, markers)
+ i <- match(marker.chr, chrmap$chr)
+ z <- happy.get.location(h, markers, scale=scale)
+ z <- z + chrmap$offset[i]
+
+ retval$marker <- markers
+ retval$genome.location <- z
+ retval$scale <- scale
+ }
+ retval
+}
+
+
+
+load.gscan <- function(files=NULL, pattern=NULL, dir="./HAPPY/BOTH/", verbose=TRUE)
+{
+ if (is.nullOrEmpty(files))
+ {
+ files <- grep(pattern, value=TRUE, list.files(dir))
+ if (0==length(files))
+ {
+ stop("Could not find files matching pattern ", pattern,
+ " in directory ", dir, "\n")
+ }
+ files <- paste(sep="/", dir, files)
+ }
+ if (verbose) cat("Loading scan files\n", paste(files, collapse="\n"), "\n")
+
+ retval <- list(phenotype=NULL, genome=NULL, chromosomes=list())
+
+ for (file in files)
+ {
+ c.scan <- read.scan.file(file)
+ c.name <- c.scan$chromosome
+ retval$chromosomes[[c.name]] <- c.scan$scan.data
+ if (is.null(retval$phenotype))
+ {
+ retval$phenotype <- c.scan$phenotype
+ }
+ else if (retval$phenotype!=c.scan$phenotype)
+ {
+ stop("Scan files must contain the same phenotype. Files:\n",
+ paste("\t",collapse="\n", files), "\nphenotypes:\n",
+ retval$phenotype, "\n", c.scan$phenotype,"\n")
+ }
+
+ retval$genome <- rbind(retval$genome, c.scan$scan.data)
+ }
+ retval
+}
+
+
+make.step.data <- function(x, y, last.x=NULL, jitter.factor=10000)
+{
+ d <- x[2:length(x)] - x[1:(length(x)-1)]
+ tiny <- min(d, na.rm=TRUE)/jitter.factor
+
+ new.x <- rep(NA, 2*length(x)-1)
+ new.x[2*(1:length(x))-1] <- x
+ new.x[2*(1:(length(x)-1))] <- x[-length(x)] + d - tiny
+ new.y <- as.numeric(y %x% c(1,1))
+ new.y <- new.y[-length(new.y)]
+
+ if (!is.null(last.x))
+ {
+ new.x <- c(new.x, last.x)
+ new.y <- c(new.y, new.y[length(new.y)])
+ }
+
+ data.frame(x=new.x, y=new.y)
+}
+
+polygonh <- function(xrange, ypos, yheight, ...)
+{
+ polygon( xrange[c(1,1,2,2)], c(ypos, rep(ypos+yheight,2), ypos), ...)
+}
+
+happy.plot.ladder <- function(h,
+ chr.list, # list("1"=matrix(ncol=2+,nrow=nloci, ...)
+ scale,
+
+ add = FALSE,
+
+ ## ladder plot
+ chr.xaxis.col = "gray50",
+ chr.yaxis.cex = 0.8,
+ yspace = diff(ylim)*0.1,
+
+ ## individual chromosome plots
+ col = "black",
+ draw.edge.support = FALSE,
+ fill = FALSE,
+ lty = 1,
+ type = "l",
+ ylim = c(0,1),
+ ...) # other arguments to happy.plot.intervals
+{
+ chr.names <- names(chr.list)
+ longest.chr <- chr.names[which.max(
+ happy.get.chromosome.length(h, chr.names, scale=scale))]
+
+ yrange <- diff(ylim)
+ true.ylim <- c(ylim[1], ylim[1] + (yrange+yspace)*length(chr.list)-yspace)
+ y.offset <- rev(ylim[1] + ((1:length(chr.list))-1)*(yrange+yspace))
+
+ if (!add)
+ {
+ happy.plot.intervals(h, chr=longest.chr, ylim=true.ylim, type="n",
+ scale=scale, axis.y=FALSE, ...)
+ ## annotate ylim for top chromosome only
+ pretty.ylim.value <- round(ylim,0)
+ pretty.ylim.pos <- pretty.ylim.value+y.offset[1]
+ mtext(pretty.ylim.value, at=pretty.ylim.pos, side=2,
+ col=chr.xaxis.col, las=1, line=-1, cex=chr.yaxis.cex)
+
+ ## draw chr axes, chr names and a representative ylim
+ for (ic in 1:length(chr.list))
+ {
+ chr <- chr.names[ic]
+ chr.y.offset <- y.offset[ic]
+ chr.ylim <- c(chr.y.offset, chr.y.offset+yrange)
+ chr.xlim <- c(
+ happy.get.interval.range(h, happy.get.first.marker(h, chr=chr), scale=scale)[1],
+ happy.get.interval.range(h, happy.get.last.marker(h, chr=chr), scale=scale)[2])
+ lines(chr.xlim, rep(chr.y.offset[1],2), col=chr.xaxis.col)
+
+ #happy.plot.intervals(add=TRUE, h, chr=chr, y=chr.y.offset,
+ # draw.edge.support=FALSE, col=chr.xaxis.col, scale=scale)
+
+ mtext(chr, side=2, at=mean(chr.ylim), las=1)
+ }
+ }
+
+ for (ic in 1:length(chr.list))
+ {
+ chr <- chr.names[ic]
+ chr.y.offset <- y.offset[ic]
+ chr.ylim <- c(chr.y.offset, chr.y.offset+yrange)
+
+ if (!force.logical(2<=ncol(chr.list[[ic]]))) next
+ data <- chr.list[[ic]]
+ if (0==nrow(data)) next
+
+ ny <- ncol(data)-1
+ for (iy in 1:ny)
+ {
+ # if (any(is.na(data[,iy+1]))) next
+ happy.plot.intervals(add=TRUE, h, chr=chr,
+ loci = data[,1],
+ y = data[,iy+1]+chr.y.offset,
+ ylim = chr.ylim,
+ col=ifelse(ny==length(col), col[iy], col),
+ draw.edge.support = ifelse(
+ ny==length(draw.edge.support),
+ draw.edge.support[iy],
+ draw.edge.support),
+ fill = ifelse(ny==length(fill), fill[iy], fill),
+ lty=ifelse(ny==length(lty), lty[iy], lty),
+ type=type,
+ scale = scale,
+ ...)
+ }
+ }
+}
+
+happy.plot.ladder.chr.list <- function(chr.names, data,
+ chr.col="chr", wanted.cols="locus", constant.cols=list())
+# to help with input for happy.plot.ladder()
+{
+ chr.list <- list()
+ for (chr in chr.names)
+ {
+ i <- data[,chr.col]==as.character(chr)
+ d <- data[i,wanted.cols]
+ for (nam in names(constant.cols))
+ {
+ d[,nam] <- constant.cols[[nam]]
+ }
+ chr.list[[chr]] <- d
+ }
+ chr.list
+}
+
+
+
+happy.plot.intervals <- function(h,
+ loci = NULL,
+ y = NULL,
+ chr = NULL,
+ scale = "cM",
+ loci.lim = NULL,
+ ylim = c(0,1),
+ add = FALSE,
+
+ axes = !add,
+ axis.x = axes,
+ axis.y = axes,
+ axis.x.extend = NULL,
+
+ type = "l",
+ lty = 1,
+ na.edge.lty = 2,
+ fill = NULL,
+ na.edge.density = NA,
+ missing.y = NA,
+ draw.edge.support = FALSE,
+
+ flag.missing.y.line = function(x,...){},
+
+ ## pass through
+ xlab = scale,
+ ylab = "",
+ ...)
+{
+ ##-----------------
+ ## Check arguments
+ ##-----------------
+ ## Non -cM scale relies on base pairs being defined
+ if (scale!="cM")
+ {
+ happy.check.bp(h)
+ }
+
+ ## establish which chromosomes and loci are to be plotted
+ if (!all(force.logical(chr)) & !all(force.logical(loci)))
+ {
+ stop("One or both of chr or loci must be completely defined in happy.plot.intervals\n")
+ }
+ ## establish y data
+ if (is.null(y))
+ {
+ y <- rep(0, length(loci))
+ }
+ else if (1==length(y) & 1<length(loci))
+ {
+ y <- rep(y, length(loci))
+ }
+ else if (length(y) != length(loci))
+ {
+ stop("Length of x and y differ: ",length(loci), " loci and ",
+ length(y), " y values\n")
+ }
+
+ if (!all(force.logical(chr)))
+ {
+ chr <- happy.get.chromosome(h, loci)
+ }
+
+ chr=unique(chr) # ????? Doing this here (rather than uniqing multiple times) may have hidden consequences - but not sure what they are ??
+ all.chr <- happy.list.chromosomes(h)[happy.list.chromosomes(h) %in% unique(chr)]
+ is.multiple.chroms <- 1<length(unique(chr))
+ pad.loci <- NULL
+ xlim <- NULL
+ if (!is.multiple.chroms)
+ {
+ ## locus range
+ if (is.null(loci.lim)) {
+ loci.lim <- ifow(add,
+ c(loci[1], loci[length(loci)]),
+ c(happy.get.first.marker(h, chr=chr), happy.get.last.marker(h, chr=chr)))
+ }
+ else if (2!=length(loci.lim))
+ {
+ stop("loci.lim must specify two markers\n")
+ }
+ if (0>diff(happy.get.location(h, loci.lim, scale=scale)))
+ {
+ loci.lim <- rev(loci.lim)
+ }
+ pad.loci <- happy.get.markers.between(h,
+ from = loci.lim[1],
+ to = loci.lim[2])
+ xmat <- as.matrix(happy.get.interval.range(h, pad.loci,scale=scale))
+ xlim <- c(xmat[1,1], tail(xmat,1)[1,2])
+
+ if (!add)
+ {
+ plot(xlim, ylim, type="n", axes=FALSE, xlab=xlab, ylab=ylab,
+ ylim=ylim, ...)
+ if (axis.y) axis(2, las=1)
+ if (axis.x)
+ {
+ alim=range(axis(1))
+ if (!is.null(axis.x.extend))
+ # experimental -- unclear whether this is desireable
+ {
+ axdiff=abs(xlim-alim)/diff(xlim)
+ if (axdiff[1] > axis.x.extend)
+ {
+ #axis(1, at=xlim[1], labels="")
+ axis(1, at=c(xlim[1],alim[1]), labels=rep("",2), tcl=0)
+ }
+ if (axdiff[2] > axis.x.extend)
+ {
+ #axis(1, at=xlim[2], labels="")
+ axis(1, at=c(alim[2],xlim[2]), labels=rep("",2), tcl=0)
+ }
+ }
+ }
+ }
+ }
+ else # multiple chromosomes
+ {
+ pad.loci <- happy.get.markers(h, chr=all.chr)
+ gloc.list <- happy.make.genome.location(h, markers=pad.loci, scale=scale)
+ locus.begin <- gloc.list$genome.location
+ locus.end <- locus.begin +
+ happy.get.interval.length(h, pad.loci, scale=scale)
+ xmat <- cbind(locus.begin, locus.end)
+ xlim <- c(xmat[1,1], tail(xmat,1)[1,2])
+
+ if (!add)
+ {
+ plot(xlim, ylim, type="n", axes=FALSE, xlab=xlab, ylab=ylab,
+ ylim=ylim, ...)
+ if (axis.y) axis(2, las=1)
+ if (axis.x)
+ {
+ chr.limits <- gloc.list$chr.limits
+ for (ic in 1:nrow(chr.limits))
+ {
+ axis(1, at=chr.limits[ic,c("start", "end")], labels=c("",""))
+ axis(1, at=chr.limits$midpoint[ic], labels=chr.limits$chr[ic], lty=0)
+ }
+ }
+ }
+ }
+
+ ## pad y with NAs where necessary
+ if (!is.null(loci))
+ {
+ pad.y <- rep(missing.y, length(pad.loci))
+ pad.y[match(loci, pad.loci)] <- y
+ y <- pad.y
+ loci <- pad.loci
+ }
+
+ ## fill
+ if (force.logical(fill[1]))
+ {
+ if (length(loci) != length(fill)) {
+ if (1 == length(fill)) {
+ fill <- rep(fill, length.out=length(loci))
+ } else {
+ stop("Bad \"fill\" specification: cannot use ", length(fill),
+ " colors to draw polygons for ", length(loci), " loci.\n")
+ }
+ }
+ for (i in 1:length(loci))
+ {
+ if (is.na(y[i])) next
+
+ if (1==i | length(loci)==i | any(is.na(y[i-1])) | is.na(y[i+1]) )
+ {
+ polygonh(xmat[i,1:2], ylim[1], y[i]-ylim[1], col=fill[i],
+ density=na.edge.density)
+ }
+ else if (y[i]!=ylim[1])
+ {
+ polygonh(xmat[i,1:2], ylim[1], y[i]-ylim[1], col=fill[i],
+ density=NA)
+ }
+ }
+ }
+
+ ## lines
+ if ("n"!=type)
+ {
+ # make sure loci and y are in order
+ # oi <- order(happy.get.location(h, loci, scale=scale))
+ # y <- y[oi]
+ # loci <- loci[oi]
+
+ max.coords <- 2*length(loci)+1
+ from.x <- numeric(max.coords)
+ from.y <- numeric(max.coords)
+ to.x <- numeric(max.coords)
+ to.y <- numeric(max.coords)
+
+ k <- 1
+ for (i in 1:length(loci))
+ {
+ if (is.na(y[i]))
+ {
+ flag.missing.y.line(xmat[i,c(1,2)], locus=loci[i], ylim=ylim)
+ next
+ }
+
+ # top lines
+ from.x[k] <- xmat[i,1]
+ from.y[k] <- y[i]
+ to.x[k] <- xmat[i,2]
+ to.y[k] <- y[i]
+ k <- k+1
+
+ ## draw left support
+ if (1<i)
+ {
+ if (is.finite(y[i-1]) | force.logical(y[i-1]!=y[i], na=FALSE))
+ {
+ from.x[k] <- xmat[i,1]
+ from.y[k] <- y[i-1]
+ to.x[k] <- xmat[i,1]
+ to.y[k] <- y[i]
+ k <- k+1
+ }
+ else if (draw.edge.support)
+ {
+ lines(rep(xmat[i,1], 2), c(ylim[1], y[i]), type=type,
+ lty=na.edge.lty, ...)
+ }
+ }
+ ## draw right support
+ if (length(loci)==i | is.na(y[i+1])) ## if at the end of the graph
+ {
+ if (draw.edge.support)
+ {
+ lines(rep(xmat[i,2], 2), c(ylim[1], y[i]), type=type,
+ lty=na.edge.lty, ...)
+ }
+ }
+ }
+ segments(from.x, from.y, to.x, to.y, lty=lty, ...)
+ }
+ invisible()
+}
+
+
diff --git a/R/bagpipe_posboot.R b/R/bagpipe_posboot.R
new file mode 100644
index 0000000..bf7adb3
--- /dev/null
+++ b/R/bagpipe_posboot.R
@@ -0,0 +1,153 @@
+bagpipe.define.posboot.loci <- function(h, locus.range){
+ if (2!=length(locus.range)){
+ bagpipe.input.error("Must specify exactly two markers for positional bootstrap")
+ }
+ if (!all(happy.has.markers(h, locus.range))){
+ bagpipe.input.error("Unknown markers:",
+ paste(locus.range[!happy.has.markers(h, locus.range)],collapse=","))
+ }
+ if (1!=length(unique(happy.get.chromosome(h, locus.range)))){
+ bagpipe.input.error(paste(sep="",
+ "Cannot bootstrap between unlinked markers ", locus.range[1], " (chr ",
+ happy.get.chromosome(h, locus.range[1])),") and ", locus.range[2],
+ " (chr ", happy.get.chromosome(h, locus.range[2]), ")")
+ }
+ if (0 > diff(happy.get.location(h, locus.range, scale="cM"))){
+ bagpipe.input.error("Markers for positional bootstrap must in given in chromosome order")
+ }
+ happy.get.markers.between(h, from=locus.range[1], to=locus.range[2])
+}
+
+bagpipe.init.posboot.file=function(file, loci)
+{
+ boot.cols=c(paste(loci, ".LOD", sep=""), paste(loci, ".modelcmp", sep=""))
+ if (file.exists(file))
+ {
+ results <- read.delim(file)
+ format.error <- function(){bagpipe.input.error(
+ "Cannot add bootstraps to incompatible boot file ",
+ file, "; must delete or rename")}
+ if (length(boot.cols)!=ncol(results))
+ {
+ format.error()
+ }
+ if (!all(boot.cols==colnames(results)))
+ {
+ format.error()
+ }
+ return (results)
+ }
+ as.data.frame(matrix(nrow=0, ncol=length(boot.cols), dimnames=list(c(),boot.cols)))
+}
+
+bagpipe.posboot.scan <- function(h, loci, num.boots, results.file,
+ save.every=10,
+ method="multinom"){
+
+ boot.results <- bagpipe.init.posboot.file(results.file, loci)
+
+ d <- get.phenotype.data(h, config=config)
+
+ pdata <- d$pdata
+ first.boot=nrow(boot.results)+1
+ if (first.boot > num.boots){
+ return (boot.results)
+ }
+ cat("Bootstraps ", first.boot, " to ", num.boots, ":", sep="")
+
+ num.obs <- nrow(pdata)
+ obs.probs <- rep(1/num.obs, num.obs)
+ if (is.null(d$scan.options$weights.factor)){
+ d$scan.options$weights.factor <- rep(1, num.obs)
+ }
+ orig.weights <- d$scan.options$weights.factor
+ for (b in first.boot:num.boots){
+ if ("multinom"==method){
+ boot.weights <- c(rmultinom(1, size=num.obs, prob=obs.probs))
+ } else if ("dirichlet"==method){
+ w <- runif(num.obs)
+ boot.weights <- w*length(w)/sum(w)
+ }
+ d$scan.options$weights.factor <- orig.weights*boot.weights
+ scan.result <- scan.phenotype(h, config, markers=loci, scan.type="scan", verbose=FALSE, data.object=d)
+ boot.results[b,] <- c(scan.result$table$LOD, scan.result$table$modelcmp)
+ if (b-first.boot %% save.every != 0 | b==num.boots){
+ write.delim(boot.results, file=results.file)
+ }
+ cat("[",sep="",b,"]")
+ }
+ cat("\n")
+ boot.results
+}
+
+make.posboot.summary <- function(h, loci, boot.results){
+ boot.summary=data.frame(
+ locus=loci,
+ chr=happy.get.chromosome(h, loci),
+ cM.start=happy.get.interval.range(h, loci, scale="cM")[,1],
+ cM.end=happy.get.interval.range(h, loci, scale="cM")[,2],
+ Mb.start=happy.get.interval.range(h, loci, scale="Mb")[,1],
+ Mb.end=happy.get.interval.range(h, loci, scale="Mb")[,2],
+ times.max.LOD=rep(0, length(loci)),
+ times.max.modelcmp=rep(0, length(loci)))
+
+ lods=as.matrix(boot.results[,1:length(loci)])
+ lods.max=table(apply(lods, 1, which.max))
+ boot.summary$times.max.LOD[as.integer(names(lods.max))] = lods.max
+ boot.summary$cumfrac.max.LOD=cumsum(boot.summary$times.max.LOD)/num.boots
+
+ cmps=as.matrix(boot.results[,-c(1:length(loci))])
+ cmps.max=table(apply(cmps, 1, which.max))
+ boot.summary$times.max.modelcmp[as.integer(names(cmps.max))] = cmps.max
+ boot.summary$cumfrac.max.modelcmp=cumsum(boot.summary$times.max.modelcmp)/num.boots
+ boot.summary
+}
+
+make.posboot.summary.ci=function(h, boot.summary, prob=0.95, score="LOD")
+{
+ score.col=paste("times.max.",sep="",score)
+ ci=which.wide.ci(boot.summary[,score.col], prob=prob)
+ data.frame(
+ score=score,
+ ci=prob,
+ idx.start=ci[1],
+ idx.end=ci[2],
+ first.marker.interval=boot.summary$locus[ci[1]],
+ last.marker.interval=boot.summary$locus[ci[2]],
+ marker.start=boot.summary$locus[ci[1]],
+ marker.end=happy.get.next.marker(h, boot.summary$locus[ci[2]], as.intervals=FALSE, within.chr=TRUE),
+ cM.start=boot.summary$cM.start[ci[1]],
+ cM.end=boot.summary$cM.end[ci[2]],
+ Mb.start=boot.summary$Mb.start[ci[1]],
+ Mb.end=boot.summary$Mb.end[ci[2]])
+}
+
+which.wide.ci=function(counts, prob)
+{
+ cumfrac=cumsum(counts)/sum(counts)
+ tailfrac=ifelse(cumfrac > 0.5, 1-cumfrac, cumfrac)
+ tailfrac.target=(1-prob)/2
+ delta=tailfrac-tailfrac.target
+
+ ge0 = 0<=delta
+ first.ge0=which(ge0)[1]
+ lower.q=first.ge0
+ if (0!=delta[first.ge0] & 1!=first.ge0)
+ {
+ lower.q=which(delta==delta[first.ge0-1])[1]
+ }
+
+ last.ge0=rev(which(ge0))[1]
+ upper.q=last.ge0
+ if (0!=delta[last.ge0] & length(counts)!=last.ge0)
+ {
+ upper.q=rev(which(delta==delta[last.ge0+1]))[1]
+ }
+ c(lower.q, upper.q)
+}
+
+
+
+
+
+
diff --git a/R/bagpipe_undernull.R b/R/bagpipe_undernull.R
new file mode 100644
index 0000000..a824866
--- /dev/null
+++ b/R/bagpipe_undernull.R
@@ -0,0 +1,212 @@
+apply.permutation.matrix <- function(original.response, perm.matrix){
+ responses.list <- list()
+ for (i in 1:ncol(perm.matrix)){
+ if (is.data.frame(original.response)) {
+ responses.list[[i]] <- original.response[perm.matrix[,i],]
+ }
+ else{
+ responses.list[[i]] <- original.response[perm.matrix[,i]]
+ }
+ }
+ responses.list
+}
+
+
+make.permuted.responses <- function(h,
+ null.formula,
+ num.perms,
+ data,
+ seed)
+{
+ perm.matrix <- permutation.matrix(
+ num.perms = num.perms,
+ data = data,
+ seed = seed)
+ response.vars <- split.formula(null.formula)$response.vars
+ original.response <- data[,response.vars]
+ list(SUBJECT.NAME=data$SUBJECT.NAME,
+ apply.permutation.matrix(original.response, perm.matrix))
+}
+
+#' Simulates phenotypes under a null model using parametric bootstrapping.
+#'
+#' First fits the null model, then simulates \code{num.responses} independent realizations of the phenotype. In order to accommodate ydim dimensional phenotypes (eg, survival outcomes, etc), each realization is provided as an nrow(data) by ydim data.frame.
+#'
+#' @param data is assumed to be non-missing for all variables in \code{null.formula}.
+#'
+#' @return A length list of \code{num.responses} data frames where each data frame contains n rows and ydim columns.
+make.parboot.responses <- function(h,
+ null.formula,
+ num.responses,
+ data,
+ seed,
+ model.type,
+ model.args)
+{
+ set.seed(seed)
+ response.vars <- split.formula(null.formula)$response.vars
+ if (1!=length(response.vars)){
+ stop("Can currently handle only univariate nullsims\n")
+ }
+ if (bagpipe.formula.has.abstract.loci(null.formula)) {
+ bagpipe.input.error("Cannot currently perform null simulations that include THE.LOCUS\n")
+ }
+ fit <- unify.fit(null.formula, data=data, model.type=model.type, args=model.args)
+ responses.list <- list()
+ for (i in 1:num.responses){
+ responses.list[[i]] <- unify.simulate(fit)
+ }
+ list(SUBJECT.NAME=data$SUBJECT.NAME, responses.list=responses.list)
+}
+
+make.parboot.permuted.responses <- function(h,
+ null.formula,
+ num.responses,
+ data,
+ seed,
+ model.type,
+ model.args)
+{
+ stop("Function needs update")
+ perm.matrix <- make.parboot.permutation.matrix(
+ null.formula,
+ num.responses,
+ data=data,
+ seed=seed,
+ model.type=model.type,
+ model.args=model.args)
+ response.vars <- split.formula(null.formula)$response.vars
+ original.response <- data[,response.vars]
+ list(SUBJECT.NAME=data$SUBJECT.NAME, responses.list=apply.permutation.matrix(original.response, perm.matrix))
+}
+
+
+make.parboot.permutation.matrix <- function(
+ null.formula,
+ num.responses,
+ data,
+ seed,
+ model.type,
+ model.args)
+{
+ set.seed(seed)
+ response.vars=split.formula(null.formula)$response.vars
+ if (1!=length(response.vars)){
+ stop("Can currently handle only univariate nullsimperms\n")
+ }
+ if (bagpipe.formula.has.abstract.loci(null.formula)){
+ bagpipe.input.error("Cannot currently perform null simulations that include THE.LOCUS\n")
+ }
+
+ y=data[,response.vars]
+
+ fake.response.name="FAKE.Z"
+ perm.matrix=matrix(nrow=length(y), ncol=num.responses)
+ for (i in 1:num.responses)
+ {
+ # generate new response
+ r=rank(y, ties="random")
+ rank2yindex=order(r)
+
+ z=r # question about whether to use non-identity z <- f(r)
+
+ # fit model to z
+ data[,fake.response.name]=z
+ zform=paste(fake.response.name, "~", split.formula(null.formula)$predictor.string)
+ fit=unify.fit(zform, data=data, model.type=model.type, args=model.args)
+ zstar=as.numeric(unify.simulate(fit))
+
+ # generate new ranks
+ rstar=rank(zstar, ties="random")
+ # generate implied permutation
+ yistar=rank2yindex[rstar]
+
+ perm.matrix[,i]=yistar
+ }
+ perm.matrix
+}
+
+#' Read a file of fake or null phenotype data that will be used to judge significance thresholds
+#'
+#' @return A list with two components:
+#' SUBJECT.NAME, a vector of the subject names for which phenotype values are provided
+#' responses.list, a list of data frames, one for each realization of the fake phenotype. Each data.frame should contain all response variables (ie, one column if univariate, ydim columns if ydim-multivariate).
+read.nullphenotype.file <- function(file, ref.data, num.required){
+ bagpipe.proc.message("Reading null phenotype file ", file, ".")
+ fake.phenotypes <- NULL
+ if (igrep("\\.csv$", file)){
+ null.data <- read.csv(file, stringsAsFactors=FALSE)
+ if ("SUBJECT.NAME"!=colnames(null.data)[1]){
+ bagpipe.input.error("In nullphenotype.file ", file, ", first column must be SUBJECT.NAME\n")
+ }
+ if (num.required + 1 > ncol(null.data)){
+ bagpipe.input.error("In nullphenotype.file ", file, ", need at least ", num.required, " columns (excluding the SUBJECT.NAME column) but only got ", ncol(null.data)-1, ".")
+ }
+ # check mapped subjects are
+ si <- match(ref.data$SUBJECT.NAME, null.data$SUBJECT.NAME)
+ if (any(is.na(si))){
+ browser()
+ bagpipe.input.error("In nullphenotype.file ", file, " phenotype values are missing for ",
+ sum(is.na(si)), " members of the mapping population.")
+ }
+ responses.list <- list()
+ for (r in 1:num.required){
+ responses.list[[r]] <- as.data.frame(null.data[si, r+1])
+ }
+ fake.phenotypes <- list(
+ SUBJECT.NAME=null.data$SUBJECT.NAME[si],
+ responses.list=responses.list)
+ }
+ if (igrep("\\.RDS$", file)){
+ fake.phenotypes <- readRDS(file)
+ if (any(ref.data$SUBJECT.NAME!=fake.phenotypes$SUBJECT.NAME)){
+ bagpipe.input.error("In nullphenotype.file ", file, ", subjects are mismatched.")
+ }
+ if (length(fake.phenotypes$responses.list) < num.required){
+ bagpipe.input.error("In nullphenotype.file ", file, ", need at least ", num.required, " phenotype realizations but only got ", length(fake.phenotypes$responses.list))
+ }
+ }
+ fake.phenotypes
+}
+
+
+fit.gev <- function( data, thresholds ){
+ require(evd)
+ model.gev <- fgev(data)
+ gev.df <- data.frame(
+ loc = model.gev$estimate[1],
+ loc.se = model.gev$std.err[1],
+ scale = model.gev$estimate[2],
+ scale.se = model.gev$std.err[2],
+ shape = model.gev$estimate[3],
+ shape.se = model.gev$estimate[3]
+ )
+ gev.thresholds.df <- data.frame(
+ upper.tail.prob=thresholds,
+ quantile = qgev(thresholds,
+ loc = gev.df$loc,
+ scale = gev.df$scale,
+ shape = gev.df$shape,
+ lower.tail=FALSE)
+ )
+ return (list(thresholds=gev.thresholds.df, gev=gev.df))
+}
+
+permutation.matrix <- function(num.perms,
+ data,
+ seed = NULL)
+# make matrix of permuted indices
+{
+ if (!is.null(seed)) set.seed(seed)
+ if (0 >= num.perms)
+ {
+ stop("Cannot permute 0 or fewer times\n")
+ }
+ mat <- matrix(integer(0), nrow=nrow(data), ncol=num.perms )
+ id <- 1:nrow(data)
+ for( p in 1:num.perms)
+ {
+ mat[,p] <- sample(id, replace=FALSE)
+ }
+ return(mat)
+}
diff --git a/R/bagpipe_utils.R b/R/bagpipe_utils.R
new file mode 100755
index 0000000..6ff7b1f
--- /dev/null
+++ b/R/bagpipe_utils.R
@@ -0,0 +1,222 @@
+bagpipe.devel.mode <- function(){
+ detach("package:bagpipe.backend")
+ dirs <- file.path(c(
+ ENV("$CODE/R/packages/RWVmisc/WVmisc"),
+ ENV("$CODE/R/packages/RWVhash/WVhash"),
+ ENV("$CODE/R/packages/Rcmdline/cmdline"),
+ ENV("$CODE/R/packages/Rconfigfile/configfile"),
+ ENV("$CODE/R/packages/Rread.happy/read.happy"),
+ ENV("$CODE/R/packages/Rbagpipe/bagpipe"),
+ ENV("$CODE/R/packages/RDiploprobReader/DiploprobReader")
+ ), "R")
+ files <- list.files(path=dirs, pattern="*.R$", full.names=TRUE)
+ invisible(mapply(source, files))
+}
+
+apply.transform <- function(formula, data)
+{
+ if (!is.character(formula))
+ {
+ formula <- as.character(deparse(formula))
+ }
+ response <- sub("~.*", "", formula)
+ eval(parse(text=response), env=data)
+}
+
+is.informative.predictor <- function(x)
+# returns true iff there is more than one unique combination
+# of values in x
+{
+ x <- as.data.frame(x)
+
+ # remove missing data
+ ok <- complete.cases(x)
+ if ( !all(ok) )
+ x <- as.data.frame(x[ok,])
+
+ # look for heterogeneity by column
+ for (i in 1:ncol(x))
+ {
+ if (1 < length(unique(x[,i])))
+ {
+ return (T)
+ }
+ }
+
+ # look for heterogeneity among combinations
+ return ( 1 < length(unique(x)) )
+}
+
+
+cols.as <- function(df, convert=list(), pattern=NULL, Class=NULL,
+ character=NULL, integer=NULL, numeric=NULL, factor=NULL)
+# returns input (a dataframe) with specified columns converted to
+# specified data type, all other columns are returned untouched.
+#
+# Arguments:
+# df: data frame input
+#
+# convert: list specifying conversion with keys being column names
+# and values being either the name of the data type,
+# eg, "integer", or a character vector specifying the order of
+# levels in a factor, eg, c("spring", "summer", "autumn", "winter")
+#
+# pattern: optional pattern to match against
+#
+# Class: Class to assign to columns matching the pattern
+#
+# Details:
+# For every type name specified there must be a corresponding
+# as.type function, eg, integer requires there to be as.integer()
+#
+# Examples:
+#
+# data <- cols.as(read.delim("phenotype.txt"), list(
+# SUBJECT.NAME="character",
+# Date.Month="factor",
+# Date.Season=c("summer", "autumn", "winter", "spring"))
+# )
+{
+ require(methods) # for as()
+
+ if (!is.null(pattern) & !is.null(Class))
+ {
+ matching.cols <- grep(pattern, value=TRUE, colnames(df))
+ conv <- list()
+ conv[matching.cols] <- Class
+ convert <- c(convert, conv)
+ }
+ if (!is.null(character)) convert[character] <- "character"
+ if (!is.null(integer)) convert[integer] <- "integer"
+ if (!is.null(numeric)) convert[numeric] <- "numeric"
+ if (!is.null(factor)) convert[factor] <- "factor"
+
+ for (name in names(convert))
+ {
+ if (1==length(convert[[name]]))
+ {
+ func <- paste("as.",convert[[name]],sep="")
+ df[,name] <- as(df[,name], convert[[name]])
+ }
+ else
+ {
+ df[,name] <- factor(as.character(df[,name]), levels=convert[[name]])
+ }
+ }
+ df
+}
+
+drop.formula.vars <- function(formulae, patterns)
+# removes all rhs terms that include variables matching in patterns
+# eg, drop.formula.vars("y ~ alpha + beta + gamma + gamma*beta", "beta")
+# would return "y~alpha + gamma"
+{
+ formulae <- formula.as.string(formulae)
+ for (patt in patterns)
+ {
+ for (i in grep(patt, formulae))
+ {
+ form <- formulae[i]
+ spf <- split.formula(form)
+ terms <- spf$predictors
+ unwanted <- grep(patt, terms)
+ form <- paste(spf$response, sep=" ~ ",
+ paste(terms[-unwanted], collapse=" + "))
+ formulae[i] <- form
+ }
+ }
+ formulae
+}
+
+is.nullOrEmpty <- function(x)
+# Returns TRUE if x is null or contains no elements
+# Purpose: deals with a common scenario arising in R. Statements like
+# if (is.null(x) | 0==nrow(x)) {
+# won't work because all K components of a logical statement in R are
+# evaluated before the statement returns a value, even though only
+# the first k < K may need to be evaluated to determine the result (ie,
+# in contrast to Perl).
+{
+ if (is.null(x))
+ {
+ return (TRUE)
+ }
+ if (0==length(x)) return (TRUE)
+ if (0==prod(dim(x))) return (TRUE)
+ FALSE
+}
+
+find.peaks <- function(series, span=3, ends=FALSE)
+# returns indices of all peaks in a series,
+# where peak is defined as a point higher than any of the span % 2
+# (ie, default 1) point(s) either side
+# If ends==TRUE then terminii are included
+{
+ if (0==span %% 2)
+ {
+ span <- span + 1
+ warning("span should be an odd number in find.peaks(): ", span-1, ".",
+ " Forcing span = ", span,"\n")
+ }
+ z <- embed(series, span)
+ col.radius <- span %/% 2
+ mid.col <- col.radius + 1
+ result <- max.col(z) == mid.col
+ retval <- which(result) + col.radius
+ if (ends & 3==span)
+ {
+ if( series[1] > series[2] )
+ {
+ retval <- c(0, retval)
+ }
+ if (series[length(series)] > series[length(series)-1])
+ {
+ retval[length(retval)+1] <- length(series)
+ }
+ }
+ retval
+}
+
+find.windowed.peaks <- function(x, y, radius, above=min(y), ...)
+# returns indices of windowed peaks,
+# where windowed peaks are defined as the highest peaks separated by
+# more than $radius x units.
+# $above specifies a y threshold below which peaks are ignored.
+#
+# Details: x must be ordered.
+# Value: indices in x order
+#
+{
+ d <- data.frame(x=x, y=y, index=1:length(y))
+ d$peak <- FALSE
+ d$windowed.peak <- FALSE
+ d$peak[find.peaks(y, ...)] <- TRUE
+ d$peak[d$y <= above] <- FALSE
+ d <- d[order(-d$y),]
+
+ for (i in which(d$peak))
+ {
+ if (d$peak[i]==FALSE) next
+ d$windowed.peak[i] <- TRUE
+ d$peak[abs(d$x[i] - d$x)<= radius] <- FALSE
+ }
+ sort(d$index[d$windowed.peak])
+}
+
+
+freeman.tukey <- function(x)
+# Freeman-Tukey transform for Poisson count data
+{
+ 0.5 * (sqrt(x) + sqrt(x+1))
+}
+
+
+reduce.dim <- function(x, sdev.cutoff=0.01,
+ cor=FALSE, scale=TRUE, center=TRUE)
+# reduces the dimensionality of a matrix by choosing
+{
+ x <- as.matrix(x)
+ prc <- prcomp(x, cor=cor, scale=scale, center=center)
+ return ( x %*% prc$rotation[,which(prc$sdev > sdev.cutoff)] )
+}
+
diff --git a/R/cmdline.R b/R/cmdline.R
new file mode 100644
index 0000000..0b7bb46
--- /dev/null
+++ b/R/cmdline.R
@@ -0,0 +1,119 @@
+cmdline.integer <- function(key, ...)
+# return the value part of a command line option as an integer
+{
+ cmdline.integers(key, ..., howmany=1)
+}
+
+cmdline.integers <- function(key, ...)
+{
+ s <- cmdline.strings(key, ...)
+ if (!is.null(s)) return (as.integer(s))
+}
+
+cmdline.flag <- function(name)
+# return TRUE iff command line flag was present
+# Note: --arg=value are not considered flags
+{
+ 0 != length(grep(paste("^--",name,"$", sep=""), commandArgs(trailingOnly=TRUE)))
+}
+
+cmdline.logical <- function(key, ...)
+# return value part of command line option as numeric
+{
+ cmdline.logicals(key, ..., howmany=1)
+}
+
+cmdline.logicals <- function(key, ...)
+# return value part of command line option as numeric
+{
+ s <- cmdline.strings(key,...)
+ if (!is.null(s))
+ {
+ ints=integer(length(s))
+ for (i in 1:length(s))
+ {
+ ints[i] = as.logical(as.integer(switch(s[i], "T"=1, "F"=0, "TRUE"=1, "FALSE"=0, s[i])))
+ }
+ return (as.logical(ints))
+ }
+}
+
+cmdline.numeric <- function(key, ...)
+# return value part of command line option as numeric
+{
+ cmdline.numerics(key, ..., howmany=1)
+}
+
+cmdline.numerics <- function(key, ...)
+# return value part of command line option as numeric
+{
+ s <- cmdline.strings(key, ...)
+ if (!is.null(s)) return (as.numeric(s))
+}
+
+
+cmdline.has.option <- function(key)
+# return true if option was specified
+{
+ !is.null(cmdline.option(key, allow.omit=TRUE))
+}
+
+cmdline.option <- function(key, default=NULL,
+ stop.on.fail=TRUE,
+ allow.omit=!stop.on.fail,
+ allowed.values=NULL)
+# return the value part of a command line option
+{
+ ca <- grep("=", grep("^--", commandArgs(trailingOnly=TRUE), value=TRUE), value=TRUE)
+
+ keys <- sub(pattern="=.*", replacement="", ca)
+ keys <- sub(keys, pattern="--", replacement="")
+ i <- match(key, keys)
+ if (is.na(i))
+ {
+ if (is.null(default))
+ {
+ if (!allow.omit) stop("Could not find key ", key, "\n")
+ return (NULL)
+ }
+ else
+ {
+ return (default)
+ }
+ }
+ values <- sub(pattern=".*=", replacement="", ca)
+
+ if (!is.null(allowed.values))
+ {
+ ok <- values[i] %in% allowed.values
+ if (!all(ok))
+ {
+ stop("Illegal values for key ", key, ": ",
+ paste(sep=" ,", values[i][!ok]), "\n")
+ }
+ }
+
+ return (values[i])
+}
+
+# for consistency
+cmdline.string <- function(key, ...)
+{
+ cmdline.option(key, ...)
+}
+
+cmdline.strings <- function(key, howmany=c(0,Inf), ...)
+# return comma separated values
+{
+ string <- cmdline.option(key, ...)
+ if (is.null(string)) return (NULL)
+ strings <- unlist(strsplit(string, split=",", perl=TRUE))
+ k <- length(strings)
+
+ howmany=rep(howmany, length.out=2)
+ if (k < howmany[1] | k > howmany[2])
+ {
+ stop("Argument ",key," requires ",howmany[1],"-",howmany[2]," values, but got ",k,": \"",paste(strings,collapse="\",\""),"\"")
+ }
+ strings
+}
\ No newline at end of file
diff --git a/R/configfile.R b/R/configfile.R
new file mode 100755
index 0000000..fa0ff66
--- /dev/null
+++ b/R/configfile.R
@@ -0,0 +1,85 @@
+#----------------------------------------------
+# configfile -- access methods for config files
+
+configfile.get <- function(config, keys, default=NULL, stop.on.fail=TRUE)
+{
+ if (!mdlist.has(config, keys))
+ {
+ if ( !stop.on.fail | (missing(stop.on.fail) & !missing(default)))
+ {
+ return (default)
+ }
+ stop("Cannot find parameters ", keys, " in configfile\n")
+ }
+ return(mdlist.get(config, keys))
+}
+
+configfile.has <- function(config, keys)
+{
+ mdlist.has(config, keys)
+}
+
+configfile.integer <- function(config, keys, ...)
+{
+ as.integer(configfile.get(config, keys, ...))
+}
+
+configfile.integers <- function(config, key, ...)
+{
+ as.integer(configfile.strings(config, key, ...))
+}
+
+configfile.logical <- function(config, keys, ...)
+{
+ as.logical(configfile.get(config, keys, ...))
+}
+
+configfile.numeric <- function(config, keys, ...)
+{
+ as.numeric(configfile.get(config, keys, ...))
+}
+
+configfile.numerics <- function(config, key, ...)
+{
+ as.numeric(configfile.strings(config, key, ...))
+}
+
+configfile.string <- configfile.get
+
+configfile.strings <- function(config, key, delim="[\\s,]+", ...)
+{
+ if (1!=length(key))
+ {
+ stop("Must pass only one key at a time to method\n")
+ }
+ string <- configfile.get(config, key, ...)
+ if (is.null(string)) return (NULL)
+ unlist(strsplit(string, split=delim, perl=TRUE))
+}
+
+read.configfile <- function(file)
+{
+ line.list <- scan(
+ file=file,
+ sep="\n",
+ strip.white=TRUE,
+ what=character(0))
+ line.vect <- as.character(line.list)
+ config <- list()
+ for (line in line.vect)
+ {
+ x <- strsplit(line, split="[[:space:]]+")[[1]]
+ key <- pop.front(x)
+ value <- paste(x, collapse=" ")
+ config <- mdlist.put(config, key, value)
+ }
+ return(config)
+}
+
+write.configfile <- function(config, file)
+{
+ string <- paste(names(config), sep="\t",
+ as.character(unlist(config)), collapse="\n")
+
+ cat(string, "\n", file=file)
+}
diff --git a/R/lmmultiresponse.R b/R/lmmultiresponse.R
new file mode 100644
index 0000000..b7c84ec
--- /dev/null
+++ b/R/lmmultiresponse.R
@@ -0,0 +1,295 @@
+SS<-function(x)
+{
+ cov(x,x)*(length(x)-1)
+}
+
+lm.multiresponse <- function(formula, response.matrix, data,
+ null.formula = NULL,
+ null.fit = NULL,
+ rsquared = FALSE,
+ pvalue = FALSE,
+ logP = FALSE,
+ LOD = FALSE,
+ total.ss = FALSE,
+ weights = rep(1, nrow(data)),
+ model.args = list(),
+ verbose.at.every = 0)
+# fits a linear model with a constant design matrix to a matrix of
+# responses. Return F-tests and pvalues for comparison with a null model
+# specified either as a formula or a fitted lm object.
+{
+ if (any(1!=weights) & (rsquared | total.ss | any(0==weights)))
+ {
+ # note: the present function gets tss and all derived statistics wrong
+ # and will probably choke if any(weights==0)
+ # However, it is several times faster than wlm and does get rss correct, which means that it also
+ # gets logP and LOD correct.
+ # Nonetheless, wlm is preferred for predictability until lm.multi has its weighted tss fixed.
+ return (
+ wlm.multiresponse(formula, response.matrix, data,
+ null.formula = null.formula,
+ rsquared = rsquared,
+ pvalue = pvalue,
+ logP = logP,
+ LOD = LOD,
+ weights = weights,
+ model.args = model.args,
+ verbose.at.every = verbose.at.every)
+ )
+ }
+
+ formula <- as.formula(formula)
+ response.matrix <- as.matrix(response.matrix)
+
+ # check response is univariate
+ terms.object <- terms(formula)
+ if (0==attr(terms.object, "response"))
+ {
+ stop("Must specify response in formula\n")
+ }
+ if (1!=attr(terms.object, "response")
+ | length(all.vars(terms.object))!=nrow(attr(terms.object, "factors")))
+ {
+ stop("Multivariate response not allowed\n")
+ }
+
+ # transform response if requested
+ response.name <- all.vars(terms.object)[1]
+ response.expr <- rownames(attr(terms.object, "factors"))[1]
+ if (response.name != response.expr)
+ {
+ FUN2 <- eval(parse(text=paste(
+ "FUN <- function(", response.name,"){",
+ response.expr,
+ "}",
+ sep="")))
+ response.matrix <- apply(response.matrix, 2, FUN2)
+ }
+ if (!all(is.finite(response.matrix)))
+ {
+ stop("Response must be finite\n")
+ }
+
+ # fit model to all responses
+ data[,response.name] <- response.matrix[,1]
+ fit <- do.call("lm", args=c(
+ model.args,
+ list(
+ formula=as.formula(formula),
+ data=quote(data),
+ weights=weights
+ )
+ ))
+ qr <- fit$qr
+ tss <- numeric(ncol(response.matrix))
+ rss <- numeric(ncol(response.matrix))
+
+ rootw <- sqrt(weights)
+ for (i in 1:ncol(response.matrix))
+ {
+ # show progress
+ if (0!=verbose.at.every)
+ {
+ if (0 == i %% verbose.at.every)
+ {
+ cat(i,"/",ncol(response.matrix),"\n")
+ }
+ }
+ # rate limiting step
+ y <- response.matrix[,i]
+ tss[i] <- sum((y-mean(y))^2*weights) # incorrect when any(1!=weights), but close
+# rss[i] <- sum( qr.resid(qr, y) ^ 2 ) # unweighted version for speed
+ rss[i] <- sum( qr.resid(qr, rootw*y) ^ 2 ) # always correct
+ }
+
+ retval <- list(
+ n = length(resid(fit)),
+ rss = rss,
+ rank = fit$rank,
+ df.residual = fit$df.residual)
+
+ if (total.ss | TRUE) retval$total.ss <- tss
+ if (rsquared) retval$rsquared <- (tss - rss) / tss
+
+
+ #------------------------------
+ # Fit null model for comparison
+ #------------------------------
+ if (!is.null(null.fit) | !is.null(null.formula))
+ {
+ if (is.null(null.formula))
+ {
+ formula.as.string(null.fit$terms)
+ }
+ if (split.formula(null.formula)$response!=split.formula(null.formula)$response)
+ {
+ stop("Response expression in formula and null formula differ: ",
+ split.formula(null.formula)$response, " vs ",
+ split.formula(formula)$response,
+ "\n")
+ }
+ if (is.null(null.fit))
+ {
+ null.fit <- do.call("lm", args=c(
+ model.args,
+ list(
+ formula=as.formula(null.formula),
+ data=quote(data),
+ weights=weights
+ )
+ ))
+ }
+
+ # get statistics from null fit
+ qr0 <- null.fit$qr
+ rss0 <- numeric(ncol(response.matrix))
+ for (i in 1:ncol(response.matrix))
+ {
+ y <- response.matrix[,i]
+ rss0[i] <- sum( qr.resid(qr0, rootw*y) ^ 2 ) # correct
+ }
+ retval$null.rss <- rss0
+ retval$null.rank <- null.fit$rank
+
+ if (pvalue | logP)
+ {
+ # calculate F-test for comparison of models
+ dfr <- fit$df.residual
+ delta.dfp <- fit$rank - null.fit$rank
+
+ fss <- rss0 - rss
+ f <- fss / rss * dfr / delta.dfp
+
+ if (pvalue | logP)
+ {
+ pval <- pf(f, delta.dfp, dfr, lower.tail=F)
+ if (pvalue) retval$pvalue <- pval
+ if (logP) retval$logP <- -log10(pval)
+ }
+ }
+ if (LOD)
+ {
+ retval$LOD <- (retval$n/2) *(log10(rss0) - log10(rss))
+ }
+ }
+ retval
+}
+
+wlm.multiresponse <- function(formula, response.matrix, data,
+ null.formula = NULL,
+ rsquared = FALSE,
+ pvalue = FALSE,
+ logP = FALSE,
+ LOD = FALSE,
+ weights = rep(1, nrow(data)),
+ model.args = list(),
+ verbose.at.every = 0)
+# fits a linear model with a constant design matrix to a matrix of
+# responses. Return F-tests and pvalues for comparison with a null model
+# specified either as a formula or a fitted lm object.
+{
+ formula <- as.formula(formula)
+ response.matrix <- as.matrix(response.matrix)
+
+ # check response is univariate
+ terms.object <- terms(formula)
+ if (0==attr(terms.object, "response"))
+ {
+ stop("Must specify response in formula\n")
+ }
+ if (1!=attr(terms.object, "response")
+ | length(all.vars(terms.object))!=nrow(attr(terms.object, "factors")))
+ {
+ stop("Multivariate response not allowed\n")
+ }
+
+ # transform response if requested
+ response.name <- all.vars(terms.object)[1]
+ response.expr <- rownames(attr(terms.object, "factors"))[1]
+ if (response.name != response.expr)
+ {
+ FUN2 <- eval(parse(text=paste(
+ "FUN <- function(", response.name,"){",
+ response.expr,
+ "}",
+ sep="")))
+ response.matrix <- apply(response.matrix, 2, FUN2)
+ }
+ if (!all(is.finite(response.matrix)))
+ {
+ stop("Response must be finite\n")
+ }
+
+ mlm.formula = paste("response.matrix ~", split.formula(formula)$predictor.string)
+ mlm.fit = do.call("lm", args=c(
+ model.args,
+ list(
+ formula=as.formula(mlm.formula),
+ data=quote(data),
+ weights=weights
+ )))
+ mlm.sum =summary(mlm.fit)
+
+ # get statistics from fit
+ rss = colSums(sapply(mlm.sum, function(x){x$residuals})^2)
+ r2 = sapply(mlm.sum, function(x){x$r.squared})
+ tss = rss/(1-r2)
+
+ result <- list(
+ n = NROW(resid(mlm.fit)),
+ tss = tss,
+ rss = rss,
+ rank = mlm.fit$rank,
+ df.residual = mlm.fit$df.residual)
+
+ if (rsquared) result$rsquared <- r2
+
+ #------------------------------
+ # Fit null model for comparison
+ #------------------------------
+ if (!is.null(null.formula))
+ {
+ if (split.formula(formula)$response!=split.formula(null.formula)$response)
+ {
+ stop("Response expression in formula and null formula differ: ",
+ split.formula(null.formula)$response, " vs ",
+ split.formula(formula)$response,
+ "\n")
+ }
+ mlm.formula0 = paste("response.matrix ~", split.formula(null.formula)$predictor.string)
+ mlm.fit0 <- do.call("lm", args=c(
+ model.args,
+ list(
+ formula=as.formula(mlm.formula0),
+ data=quote(data),
+ weights=weights
+ )
+ ))
+ mlm.sum0=summary(mlm.fit0)
+
+ # get statistics from null fit
+ result$null.rss = colSums(sapply(mlm.sum0, function(x){x$residuals})^2)
+ result$null.rank = mlm.fit0$rank
+ if (pvalue | logP)
+ {
+ # calculate F-test for comparison of models
+ dfr <- result$df.residual
+ delta.dfp <- result$rank - result$null.rank
+
+ fss <- result$null.rss - result$rss
+ f <- fss / rss * dfr / delta.dfp
+
+ if (pvalue | logP)
+ {
+ pval <- pf(f, delta.dfp, dfr, lower.tail=F)
+ if (pvalue) result$pvalue <- pval
+ if (logP) result$logP <- -log10(pval)
+ }
+ }
+ if (LOD)
+ {
+ result$LOD <- (result$n/2) *(log10(result$null.rss) - log10(rss))
+ }
+ }
+ result
+}
diff --git a/R/read.happy.core.R b/R/read.happy.core.R
new file mode 100644
index 0000000..8b48a17
--- /dev/null
+++ b/R/read.happy.core.R
@@ -0,0 +1,466 @@
+
+assert.happy <- function(h)
+{
+ if (!inherits(h, "happy.genome"))
+ {
+ stop("Object must be of class happy.genome\n")
+ }
+}
+
+happy.get.allowed.models <- function()
+{
+ c("genotype", "additive", "full", "full.asymmetric")
+}
+
+happy.get.bp <- function(ha, markers)
+{
+ ha$genotype$genome$bp[
+ match(markers, ha$genotype$genome$marker)
+ ]
+}
+
+happy.get.chromosome <- function(h, markers)
+{
+ assert.happy(h)
+ h$genotype$genome$chromosome[match(markers, h$genotype$genome$marker)]
+}
+
+happy.get.interval.length <- function(h, markers, scale="bp", fudge.bp=FALSE)
+# return the length of the interval
+{
+ d <- rep(NA, length(markers))
+
+ i <- match(markers, h$genotype$genome$marker)
+ if ("bp"==scale | "Mb"==scale)
+ {
+ start <- h$genotype$genome$bp[i]
+ end <- h$genotype$genome$bp[i+1]
+ d <- end - start
+ ok=!is.na(d)
+ if (any(d[ok] < 0))
+ {
+ if (fudge.bp)
+ {
+ stop("Fudging is currently deprecated\n")
+ # find next bp on same chrom that is higher than current bp
+ fudges <- which(d < 0)
+ for (f in fudges)
+ {
+ i.end <- which( h$genotype$genome$bp > h$genotype$genome$bp[i[f]]
+ & h$genotype$genome$chromosome == h$genotype$genome$chromosome[i[f]]
+ )[1]
+ d[f] <- h$genotype$genome$bp[i.end] - start[f]
+ }
+ }
+ else
+ {
+ warning("Cannot calculate lengths for the following intervals",
+ " because their right-flank markers have a lower bp than their",
+ " left-flank markers:",
+ paste( markers[which(d < 0)], collapse=", "),
+ "\n")
+ d[ 0 > d ] <- NA
+ }
+ }
+ if ("Mb"==scale) d <- d/1e6
+ }
+ else
+ {
+ start <- h$genotype$genome$map[i]
+ end <- h$genotype$genome$map[i+1]
+ d <- end - start
+ d[ 0 > d ] <- NA # deals with intervals of negative length
+ }
+ return (d)
+}
+
+
+happy.get.markers <- function(h,
+ chromosome = NULL,
+ model = "genotype",
+ as.intervals = TRUE)
+{
+ assert.happy(h)
+ if (!all(happy.has.model(h, unique(c(model, "genotype")))))
+ {
+ i <- happy.has.model(h, unique(c(model, "genotype")))
+ stop("Model ", model[!i], " not loaded\n")
+ }
+
+ # optimized case
+ if (is.null(chromosome))
+ {
+ if (!as.intervals)
+ {
+ return ( h$genotype$markers )
+ }
+ if ("genotype"!=model && as.intervals)
+ {
+ return ( h[[model]]$markers )
+ }
+ }
+
+ # inefficient but general
+ markers <- h$genotype$markers
+ terminii <- tapply(1:length(h$genotype$marker), h$genotype$chromosome, tail, 1)
+ is.terminus <- rep(FALSE,length(markers))
+ is.terminus[terminii] <- TRUE
+ if (is.null(chromosome)) chromosome <- unique(h$genotype$chromosome)
+
+ if ("genotype"==model)
+ {
+ if (as.intervals)
+ {
+ return (markers[
+ !is.terminus
+ & h$genotype$chromosome %in% chromosome
+ ])
+ }
+ return (markers[ h$genotype$chromosome %in% chromosome ])
+ }
+ if (as.intervals)
+ {
+ return (h[[model]]$markers[ h[[model]]$chromosome %in% chromosome ])
+ }
+ return (
+ happy.get.markers(h,
+ chromosome=chromosome,
+ model="genotype",
+ as.intervals=FALSE)
+ )
+}
+
+happy.get.models <- function(h)
+{
+ assert.happy(h)
+ intersect(names(h), happy.get.allowed.models())
+}
+
+happy.get.position <- function(h, markers)
+{
+ assert.happy(h)
+ h$genotype$genome$map[
+ match(markers, h$genotype$genome$marker)
+ ]
+}
+
+happy.get.subjects <- function(h)
+{
+ h$subjects
+}
+
+happy.get.strains <- function(h)
+{
+ h$strains
+}
+
+happy.has.model <- function(h, model)
+{
+ assert.happy(h)
+ model %in% happy.get.models(h)
+}
+
+
+
+happy.load.genome <- function (dir, use.X = TRUE, chr = NULL, models = NULL)
+{
+ if (!is.null(chr) & 0==length(grep("chr", chr)))
+ {
+ chr <- paste("chr",sep="",chr)
+ }
+ if (is.null(models))
+ {
+ models <- intersect(happy.get.allowed.models(), list.subdirs(dir))
+ if (0==length(models))
+ {
+ stop("No genome cache models present in ", dir, "\n")
+ }
+ if (!"genotype" %in% models)
+ {
+ stop("Required genotype model is absent from cache dir ", dir, "\n")
+ }
+ }
+ else
+ {
+ models <- unique(c(models, "genotype"))
+ }
+
+ g <- list()
+ old.subjects <- NULL
+ old.strains <- NULL
+ for (model in models)
+ {
+ pkgs <- c()
+ if (is.null(chr))
+ {
+ found.chr <- list.subdirs( paste(dir, "/", model, sep=""), pattern="^chr" )
+ if (0==length(found.chr))
+ {
+ stop("Found no chromosomes for model ", model, " in dir ", dir, "\n")
+ }
+ pkgs <- paste(dir, model, found.chr, sep = "/")
+ }
+ else
+ {
+ pkgs <- paste(dir, model, chr, sep = "/")
+ }
+ markers <- c()
+ chromosome <- c()
+ map <- c()
+ pkgname <- c()
+ bp <- c()
+ for (p in pkgs)
+ {
+ chromosome <- c(chromosome, happy.load.data("chromosome", p))
+ m <- happy.load.data("markers", p)
+ markers <- c(markers, m)
+ map <- c(map, happy.load.data("map", p))
+ bp <- c(bp, happy.load.data("bp", p))
+ pkgname <- c(pkgname, rep(p, length(m)))
+ subjects <- happy.load.data("subjects", p)
+ strains <- happy.load.data("strains", p)
+ if (is.null(old.subjects))
+ {
+ old.subjects <- subjects
+ }
+ if (any(subjects != old.subjects))
+ {
+ cat("ERROR - subject names are inconsistent for chromosome ",
+ tail(chromosome,1), "\n")
+ stop("FATAL HAPPY ERROR")
+ }
+ if (is.null(old.strains))
+ {
+ old.strains <- strains
+ }
+ if (any(strains != old.strains))
+ {
+ cat("ERROR - strain names are inconsistent for chromosome ",
+ chromosome, "\n")
+ stop("FATAL HAPPY ERROR")
+ }
+ }
+ genome <- data.frame(
+ marker = I(as.character(markers)),
+ map = as.numeric(map),
+ bp = as.numeric(bp),
+ ddp = I(as.character(pkgname)),
+ chromosome = I(as.character(chromosome)))
+ g[[model]] <- list(
+ genome = genome,
+ subjects = subjects,
+ strains = strains,
+ markers = as.character(genome$marker),
+ chromosome = as.character(genome$chromosome),
+ map = genome$map,
+ design.matrix.colnames = happy.make.colnames(strains, model=model))
+ }
+ g$subjects <- g$genotype$subjects
+ g$strains <- g$additive$strains
+ g$markers <- g$genotype$markers
+ g$haploid <- g$genotype$haploid
+
+ class(g) <- "happy.genome"
+ return(g)
+}
+
+happy.load.marker <- function(h, marker, model)
+# internal function to load data for a single marker from genome cache
+{
+ # Check for bad arguments
+ assert.happy(h)
+ if (1!=length(marker))
+ {
+ stop("Must specify only one marker in happy.load.marker()\n")
+ }
+ if (1!=length(model))
+ {
+ stop("Must specify only one model in happy.load.marker()\n")
+ }
+ if (!happy.has.model(h, model))
+ {
+ stop("No such model ", model, " in happy object\n")
+ }
+ marker <- as.character(marker)
+ model <- as.character(model)
+
+ # check whether marker is in DATA memory
+ retval <- NULL
+ if ( happy.has.reserved.marker(h, marker=marker, model=model) )
+ {
+ retval <- happy.get.reserved.marker(h, marker=marker, model=model)
+ }
+ else
+ {
+ i <- which(h[[model]]$genome$marker == marker )
+ if (1!=length(i))
+ {
+ string <- paste("marker", marker, "for ", model, " model.")
+ if (0==length(i))
+ {
+ stop("Could not find ", string, "\n")
+ }
+ if (1 < length(i))
+ {
+ stop("Found multiple markers matching", string, "\n")
+ }
+ }
+ pkg <- h[[model]]$genome$ddp[i]
+
+ max.tries <- 10
+ num.tries <- 0
+ sleep.time <- 1
+ has.loaded <- FALSE
+ retval <- NULL
+ while (!has.loaded & num.tries < max.tries)
+ {
+ ## read marker data from the genome cache
+ num.tries <- num.tries + 1
+ retval <- try( happy.load.data(marker, pkg) )
+ if (!caught.error(retval))
+ {
+ if (!is.null(retval))
+ {
+ break
+ }
+ }
+ warning("Failed to load data for ", model, " ", marker,
+ ". Retrying after ", sleep.time, "s sleep...\n")
+ system(paste("sleep", sleep.time))
+ }
+ if (caught.error(retval))
+ {
+ stop("Error retrieving information via g.data.get() for marker ", marker, "\n")
+ }
+ if (is.null(retval))
+ {
+ stop("Error: null data retrieved via g.data.get() for marker ", marker, "\n")
+ }
+ if (!is.array(retval)) retval <- as.array(retval) # ensure return value has a dim component
+ colnames(retval) <- happy.make.colnames(happy.get.strains(h), model)
+
+ if ("full"==model)
+ # bug fix for when cache contains incorrectly doubled values
+ {
+ if (2==round(sum(retval[1,]),1))
+ {
+ retval <- retval/2
+ }
+ }
+ }
+ if (happy.is.auto.reserve(h))
+ {
+ if (happy.get.reserve.limit(h) > happy.reserve.memory.usage(h))
+ {
+ happy.reserve.marker(h, marker=marker, model=model, marker.data=retval)
+ }
+ }
+ retval
+}
+
+happy.load.data <- function (item, dir) # replaces calls to g.data.get, to make things backwards compatible.
+{
+ env <- new.env()
+
+ # determine which version of g.data was used to save the data
+ # assume happy pre 2009 and g.data pre 2009
+ filename.pre2009 <- file.path(dir, "data", paste(item, "RData", sep = "."))
+ if (file.exists(filename.pre2009))
+ {
+ load(filename.pre2009, env)
+ return ( get(item, envir = env) )
+ }
+
+ # assume happy 2009 and g.data 2009
+ item.safe <- make.names(item)
+ filename.post2009 <- file.path(dir,
+ paste(gsub("([[:upper:]])", "@\\1", item.safe), "RData", sep = ".")
+ )
+ if (file.exists(filename.post2009))
+ {
+ load(filename.post2009, env)
+ return ( get(item.safe, envir = env ) )
+ }
+
+ # assume happy 2009 and g.data pre 2009
+ filename.hybrid <- file.path(dir, "data", paste(item.safe, "RData", sep = "."))
+ if (file.exists(filename.hybrid))
+ {
+ load(filename.hybrid, env)
+ return ( get(item.safe, envir = env) )
+ }
+
+ stop("Could not find object file containing data for ", item, " in package ", dir,
+ ". Tried ", filename.pre2009, ", ", filename.post2009, " and ", filename.hybrid, "\n")
+}
+
+happy.reserve.marker <- function(h, marker, model, marker.data=NULL)
+{
+ if (!happy.reserve.has(h, category=model))
+ {
+ stop("Cannot reserve marker ", marker, " for model ", model, " because memory cache has not been initialized\n")
+ }
+ if (is.null(marker.data))
+ {
+ marker.data <- happy.load.marker(h, marker=marker, model=model)
+ }
+ happy.reserve.put(h, category=model, object.name=marker, object=marker.data)
+}
+
+happy.reserve.markers <- function(h, markers, models, verbose=TRUE)
+{
+ assert.happy(h)
+ if (length(markers)!=length(models))
+ {
+ stop("Number of markers must match number of models\n")
+ }
+
+ markers <- as.character(markers)
+ models <- as.character(models)
+
+ cat("Reserving data for ", length(markers), " marker-model combinations in memory\n")
+
+ mem.size <- 0
+ memory.limit.Mb <- happy.get.reserve.limit(h)
+ if (0<length(h$DATA))
+ {
+ mem.size <- happy.reserve.memory.usage(h)/2^20
+ }
+ for (i in 1:length(markers))
+ {
+ if (happy.has.reserved.marker(h, marker=markers[i], model=models[i]))
+ {
+ next
+ }
+
+ marker.data <- happy.load.marker(h, markers[i], models[i])
+ mem.size <- mem.size + object.size(marker.data)/2^20
+ if (memory.limit.Mb <= mem.size)
+ {
+ warning(paste("Reached memory limit",round(mem.size,3),"Mb / ",
+ memory.limit.Mb,"Mb for marker reserve with",
+ i, "/",length(markers),"markers. The remaining", length(markers)-i,
+ "markers will be accessed through disk I/O\n"))
+ break
+ }
+ happy.reserve.marker(h, marker=markers[i], model=models[i], marker.data=marker.data)
+ if (verbose)
+ {
+ cat("[",i,"]",sep="")
+ }
+ }
+
+ if (verbose) cat("\n")
+ cat("Marker data consumes", round(mem.size,3), "Mb\n")
+}
+
+happy.has.reserved.marker <- function(h, marker, model)
+{
+ happy.reserve.has(h, category=model, object.name=marker)
+}
+
+happy.get.reserved.marker <- function(h, marker, model)
+{
+ happy.reserve.get(h, category=model, object.name=marker)
+}
+
diff --git a/R/read.happy.derived.R b/R/read.happy.derived.R
new file mode 100644
index 0000000..bb44d17
--- /dev/null
+++ b/R/read.happy.derived.R
@@ -0,0 +1,868 @@
+
+happy.check.bp <- function(h, stop.on.fail=TRUE)
+{
+ WARN <- stop
+ if (!stop.on.fail) WARN <- warning
+
+ assert.happy(h)
+
+ ok <- TRUE
+
+ # check markers are in map order
+ for (chr in happy.list.chromosomes(h))
+ {
+ pos <- happy.get.position(h,
+ happy.get.markers(h, chromosome=chr))
+ if (any(order(pos)!=1:length(pos)))
+ {
+ ok <- FALSE
+ WARN("Disorder in internal representation: ",
+ "markers are not in cM order\n")
+ }
+ }
+
+ # check markers have non-NA basepairs
+ all.markers <- happy.get.markers(h)
+ if (any(is.na(happy.get.bp(h, all.markers))))
+ {
+ ok <- FALSE
+ WARN("Some markers with NA bp\n")
+ }
+ ok
+}
+
+
+happy.get.allele.freq <- function(h, markers, subjects=NULL)
+{
+ freqs <- rep(NA, length(markers))
+ names(freqs) <- markers
+ for (m in markers)
+ {
+ f <- mean(na.omit(
+ happy.get.genotype(h, m, model="additive", subjects=subjects)
+ ))/2
+ freqs[m] <- min(f, 1-f)
+ }
+ return (freqs)
+}
+
+happy.get.chromosome.length <- function(h, chrom, scale="bp", subtract.offset=FALSE)
+{
+ out <- rep(NA, length(chrom))
+ for (ic in 1:length(chrom))
+ {
+ i <- h$genotype$genome$chr == chrom[ic]
+
+ rng <- NULL
+ if ("bp"==scale | "Mb"==scale)
+ {
+ rng <- range(h$genotype$genome$bp[i])
+ if ("Mb"==scale) rng <- rng/1e6
+ }
+ else if ("cM"==scale)
+ {
+ rng <- range(h$genotype$genome$map[i])
+ }
+ else
+ {
+ stop("Unknown scale type ", scale, "\n")
+ }
+
+ if (subtract.offset)
+ {
+ return (rng[2] - rng[1])
+ }
+ out[ic] <- rng[2]
+ }
+ out
+}
+
+
+happy.get.design.old <- function(h, marker,
+ model="additive",
+ subjects=NULL,
+ as.data.frame=TRUE)
+{
+ assert.happy(h)
+
+ # Specify different genotype models
+ if ("genotype"==model)
+ {
+ model <- "genotype.full"
+ }
+ hmodel <- model
+ submodel <- NULL
+ if (igrep("genotype", model))
+ {
+ submodel <- sub("genotype.", "", model)
+ hmodel <- "genotype"
+ }
+
+ # prepare dominance model
+ if ("dominance"==model)
+ {
+ hmodel <- "full"
+ }
+
+ # Load the marker data from file
+ mat <- happy.load.marker(h, marker=marker, model=hmodel)
+
+ # Reformat different genotype submodels, if applicable
+ if ("genotype"==hmodel)
+ {
+ if (submodel %in% c("additive", "dominance", "hier") )
+ {
+ mat <- as.matrix(genotype.to.hier(as.vector(mat)))
+ if ("additive"==submodel) { mat <- mat[,1] }
+ else if ("dominance"==submodel) { mat <- mat[,2] }
+ }
+ else if ("full"==submodel)
+ {
+ mat <- as.factor(mat)
+ }
+ else if ("ped"==submodel)
+ {
+ g <- genotype.to.count(as.vector(mat))
+ mat <- rep("00", length(g))
+ mat[ g==0 ] <- 11
+ mat[ g==1 ] <- 12
+ mat[ g==2 ] <- 22
+ }
+ else
+ {
+ stop("Unknown model: ", model, "\n")
+ }
+ }
+ # force to be array if 1 column
+ if (is.null(dim(mat)))
+ {
+ mat <- as.array(mat)
+ }
+ if (!is.null(subjects))
+ {
+ subjects <- as.character(subjects)
+ i <- match(subjects, happy.get.subjects(h))
+ if (1==length(dim(mat)))
+ {
+ mat <- mat[i]
+ }
+ else
+ {
+ mat <- matrix(mat[i,],
+ nrow = length(subjects),
+ ncol = ncol(mat),
+ dimnames = list(subjects, colnames(mat)))
+ }
+ }
+
+ if ("dominance"==model)
+ {
+ mat <- mat[,-(1:length(happy.get.strains(h)))]
+ }
+
+ if (as.data.frame)
+ {
+ mat <- as.data.frame(mat)
+ if (1==ncol(mat))
+ {
+ colnames(mat) <- model
+ }
+ if (!is.null(subjects))
+ {
+ rownames(mat) <- subjects
+ }
+ }
+ mat
+}
+
+happy.get.design <- function(h, marker,
+ model="additive",
+ subjects=NULL,
+ as.data.frame=TRUE,
+ sdp=NULL,
+ merge.matrix=NULL)
+{
+ assert.happy(h)
+
+ which.subjects=NULL
+ if (!is.null(subjects))
+ {
+ subjects <- as.character(subjects)
+ if (!identical(subjects,happy.get.subjects(h)))
+ {
+ which.subjects <- match(subjects, happy.get.subjects(h))
+ }
+ }
+ else
+ {
+ subjects = happy.get.subjects(h)
+ }
+
+ mat=NULL
+ if (igrep("genotype", model)) # Genotype models
+ {
+ gmodel=ifow("genotype"==model, "factor", sub("genotype\\.*", "", model, perl=TRUE))
+ mat=happy.get.genotype(h, marker=marker, genotype.model=gmodel)
+ mat=as.matrix(mat)
+ # subjects
+ if (!is.null(which.subjects))
+ {
+ mat=mat[which.subjects,]
+ }
+ rownames(mat)=happy.get.subjects(h)
+ }
+ else if (!is.null(merge.matrix))
+ {
+ M = merge.matrix
+ num.groups = ncol(M)
+ if (is.null(colnames(M)))
+ {
+ colnames(M) = paste("merge",sep="",1:ncol(M))
+ }
+ if (1 >= num.groups | happy.num.strains(h) < num.groups)
+ {
+ stop("SDP or mergematrix must specify 2-", happy.num.strains(h), " groups\n")
+ }
+ num.subjects = length(subjects)
+ group.names = colnames(M)
+
+ if ("additive"==model)
+ {
+ amat = as.matrix(happy.load.marker(h, marker=marker, model="additive"))
+ if (!is.null(which.subjects))
+ {
+ amat=amat[which.subjects,]
+ }
+ mat = amat %*% M
+ rownames(mat) = subjects
+ }
+ else if ("dominance"==model)
+ {
+ fmat = happy.get.design(h,
+ model="full",
+ marker=marker,
+ merge.matrix=M,
+ subjects=subjects,
+ as.data.frame=FALSE)
+ if (1==ncol(fmat)-num.groups)
+ {
+ mat = as.matrix(fmat[,-(1:num.groups)])
+ colnames(mat) = colnames(fmat)[-(1:num.groups)]
+ }
+ else if (1==nrow(fmat))
+ {
+ mat = t(as.matrix(fmat[,-(1:num.groups)]))
+ }
+ else
+ {
+ mat = fmat[,-(1:num.groups)]
+ }
+ }
+ else if (model %in% c("full","full.asymmetric"))
+ {
+ happy.model=ifow("full.asymmetric"==model, model, "full")
+
+ # make tensor of diplotype matrices
+ strains.tensor=happy.get.diplotype.tensor(h,
+ marker=marker, model=happy.model,
+ subjects=subjects, memoize=TRUE)
+ groups.tensor=array(numeric(0),
+ dim=c(num.groups,num.groups,num.subjects),
+ dimnames=list(group.names,group.names,subjects))
+
+ # conversion loop
+ Mt = t(M) # optimization
+ for (i in 1:num.subjects)
+ {
+ groups.tensor[,,i] = Mt %*% strains.tensor[,,i] %*% M
+ }
+
+ # flatten to happy models
+ if ("full.asymmetric"==model)
+ {
+ stop("Strain merge on full.asymmetric is not implemented yet\n")
+ }
+ else
+ {
+ row1=happy.matrixop.diplotypes.to.full(groups.tensor[,,1], symmetric.X=TRUE, want.names=TRUE)
+ row1=t(as.matrix(row1))
+ if (1==num.subjects)
+ {
+ mat=row1
+ }
+ else
+ {
+ mat=matrix(numeric(0),
+ nrow=num.subjects,
+ ncol=length(row1),
+ dimnames=list(subjects,colnames(row1)))
+ mat[1,]=row1
+ for (i in 2:num.subjects)
+ {
+ mat[i,]=happy.matrixop.diplotypes.to.full(groups.tensor[,,i],
+ symmetric.X=TRUE,
+ want.names=FALSE)
+ }
+ }
+ }
+ }
+ else
+ {
+ stop("Can't perform sdp on model '", model, "'\n")
+ }
+ }
+ else if (!is.null(sdp)) # Merged models
+ {
+ # error checking
+ if (3>happy.num.strains(h))
+ {
+ stop("sdp requires at least 3 founders\n")
+ }
+ if (length(sdp)!=happy.num.strains(h))
+ {
+ stop("sdp must have as many elements as there are founders: expected ",
+ happy.num.strains(h), ", got ",length(sdp), "\n")
+ }
+ # make merge matrix
+ M = incidence.matrix(as.factor(sdp))
+ mat=happy.get.design(h,
+ marker=marker,
+ subjects=subjects,
+ merge.matrix=M,
+ model=model,
+ as.data.frame=FALSE)
+ }
+ else # Standard Happy models
+ {
+ if ("additive"==model)
+ {
+ mat <- as.matrix(happy.load.marker(h, marker=marker, model="additive"))
+ }
+ else if ("dominance"==model)
+ {
+ mat = happy.load.marker(h, marker=marker, model="full")
+ mat = mat[,-(1:length(happy.get.strains(h)))]
+ }
+ else if ("full"==model)
+ {
+ mat <- happy.load.marker(h, marker=marker, model="full")
+ }
+ else
+ {
+ stop("Unknown model '", model, "'\n")
+ }
+ # subjects
+ if (!is.null(which.subjects))
+ {
+ if (1==length(subjects))
+ {
+ mat=t(as.matrix(mat[which.subjects,]))
+ }
+ else
+ {
+ mat=mat[which.subjects,]
+ }
+ }
+ rownames(mat)=subjects
+ }
+
+ # force to be array if 1 column
+ if (is.null(dim(mat)))
+ {
+ mat <- as.array(mat)
+ }
+
+ # convert to data frame if requested
+ if (as.data.frame)
+ {
+ mat <- as.data.frame(mat)
+ if (1==ncol(mat))
+ {
+ colnames(mat) <- model
+ }
+ }
+ mat
+}
+
+
+happy.get.genotype <- function(h, marker, genotype.model="factor")
+{
+ mat <- happy.load.marker(h, marker=marker, model="genotype")
+
+ if ("factor"==genotype.model)
+ {
+ mat <- as.factor(mat)
+ }
+ else if ("full"==genotype.model)
+ {
+ mat = incidence.matrix(as.factor(mat))
+ }
+ else if (genotype.model %in% c("additive", "dominance", "hier") )
+ {
+ mat <- as.matrix(genotype.to.hier(as.vector(mat)))
+ if ("additive"==genotype.model)
+ {
+ mat <- as.matrix(mat[,1])
+ colnames(mat) = "additive"
+ }
+ else if ("dominance"==genotype.model)
+ {
+ mat <- as.matrix(mat[,2])
+ colnames(mat) = "dominance"
+ }
+ }
+ else
+ {
+ stop("Unknown model: ", genotype.model, "\n")
+ }
+ if (is.null(dim(mat)))
+ {
+ mat <- as.array(mat)
+ }
+ mat
+}
+
+
+happy.get.diplotype.tensor <- function(h, marker, model, subjects=happy.get.subjects(h), simplify=FALSE, memoize=TRUE)
+# returns a list of diplotype matrices
+# TODO: allow caching of previously requested tensor
+{
+ assert.happy(h)
+ if (! model %in% c("full", "full.asymmetric") )
+ {
+ stop("happy.get.diplotype.matrix() only implemented for full and full.asymmetric models\n")
+ }
+ subjects <- as.character(subjects)
+
+ # simple memoizing: getter
+ if (happy.reserve.has.scratch(h) & memoize)
+ {
+ if (happy.reserve.has(h, category="scratch", object.name="scratch.diplotype.tensor"))
+ {
+ scratch=happy.reserve.get(h, category="scratch", object.name="scratch.diplotype.tensor")
+ if (all(scratch$subjects==subjects) & scratch$model==model & scratch$marker==marker)
+ {
+ return (scratch$tensor)
+ }
+ }
+ }
+
+ # create tensor
+ x.mat <- happy.get.design(h,
+ marker = marker,
+ model = model,
+ subjects = subjects,
+ as.data.frame = FALSE)
+ strains = happy.get.strains(h)
+ num.strains = length(strains)
+ num.subjects = length(subjects)
+ mat.tensor = array(numeric(0),
+ dim=c(num.strains, num.strains, length(subjects)),
+ dimnames=list(strains, strains, subjects))
+ for (i in 1:num.subjects)
+ {
+ if ("full"==model)
+ {
+ mat.tensor[,,i] = happy.matrixop.full.to.diplotypes(x.mat[i,], num.strains)
+ }
+ else if ("full.asymmetric"==model)
+ {
+ mat.tensor[,,i] <- happy.matrixop.full.asymmetric.diplotypes(x.mat[i,], num.strains)
+ }
+ }
+
+ # simple memoizing: setter
+ if (happy.reserve.has.scratch(h) & memoize)
+ {
+ scratch=list(tensor=mat.tensor, marker=marker, model=model, subjects=subjects)
+ happy.reserve.put(h, category="scratch", object.name="scratch.diplotype.tensor", object=scratch)
+ }
+
+ # reduce if a single individual and simplifying (no memoizing)
+ if (simplify & 1==length(subjects))
+ {
+ return (mat.tensor[,,1])
+ }
+ mat.tensor
+}
+
+happy.matrixop.full.to.diplotypes <- function(x, num.strains)
+{
+ m <- matrix(0, ncol=num.strains, nrow=num.strains)
+ diag(m) <- x[1:num.strains]
+ m[upper.tri(m, diag=FALSE)] = x[(num.strains+1):length(x)]
+ 0.5 * (m + t(m))
+}
+
+happy.matrixop.full.asymmetric.to.diplotypes <- function(x, num.strains)
+{
+ matrix(x, nrow=num.strains)
+}
+
+happy.matrixop.diplotypes.to.full <- function(X, symmetric.X=FALSE, want.names=TRUE)
+{
+ if (!symmetric.X)
+ {
+ X=0.5*(X+t(X))
+ }
+ f = c(diag(X), 2*X[upper.tri(X, diag=FALSE)])
+ if (want.names & !is.null(colnames(X)))
+ {
+ A=matrix(kronecker(colnames(X), colnames(X), FUN=paste, sep="."),
+ nrow=ncol(X), byrow=TRUE)
+ names(f)=c(diag(A), A[upper.tri(A, diag=FALSE)])
+ }
+ f
+}
+
+happy.get.first.marker <- function(h, chromosome=NULL)
+{
+ if (!is.null(chromosome))
+ {
+ x <- character(length(chromosome))
+ for (i in 1:length(chromosome))
+ {
+ x[i] <- happy.get.markers(h, chromosome=chromosome[i])[1]
+ }
+ return (x)
+ }
+ else
+ {
+ return (happy.get.markers(h)[1])
+ }
+}
+
+happy.get.interval.midpoint <- function(h, markers, scale="bp", fudge.bp=FALSE)
+# return the midpoint of the interval
+{
+ p <- happy.get.location(h, markers, scale=scale)
+ p + happy.get.interval.length(h, markers, scale=scale, fudge.bp=fudge.bp)/2
+}
+
+happy.get.interval.over <- function(h, chromosome, x,
+ scale = "cM",
+ use.nearest.terminus = FALSE,
+ boundary.choice = "l",
+ fudge.bp = FALSE)
+# return which intervals are over the specified locations
+# x may be a vector
+# boundary.choice == l | r | NA
+{
+ assert.happy(h)
+ chromosome <- rep(chromosome, length.out=length(x))
+ boundary.choice <- rep(boundary.choice, length.out=length(x))
+
+ markers <- happy.get.markers(h, chromosome=chromosome)
+ chrom <- happy.get.chromosome(h, markers)
+ range <- happy.get.interval.range(h, markers, scale=scale, fudge.bp=fudge.bp)
+
+ overlap.marker <- rep(NA, length(x))
+ for (i in 1:length(x))
+ {
+ my.chrom <- chromosome[i]
+ my.loc <- x[i]
+ overlap.idx <- which( my.chrom==chrom
+ & my.loc >= range[,1]
+ & my.loc <= range[,2])
+
+ if (2==length(overlap.idx))
+ {
+ if (is.na(boundary.choice[i]))
+ {
+ overlap.marker[i] <- NA
+ }
+ else if ("l"==boundary.choice[i])
+ {
+ overlap.marker[i] <- markers[overlap.idx[1]]
+ }
+ else
+ {
+ overlap.marker[i] <- markers[overlap.idx[2]]
+ }
+ }
+ if (1==length(overlap.idx))
+ {
+ overlap.marker[i] <- markers[overlap.idx]
+ }
+ if (0==length(overlap.idx) & use.nearest.terminus)
+ {
+ is.early <- my.loc < happy.get.location(h, scale=scale,
+ happy.get.first.marker(h, chromosome=my.chrom))
+ overlap.marker[i] <- ifelse(is.early,
+ happy.get.first.marker(h, chromosome=my.chrom),
+ happy.get.last.marker(h, chromosome=my.chrom))
+ }
+ }
+ overlap.marker
+}
+
+happy.get.interval.range <- function(h, markers, scale="cM", fudge.bp=FALSE)
+# get start bp and end bp of requested intervals
+{
+ r <- happy.get.location(h, markers, scale=scale)
+ r <- cbind(r, r + happy.get.interval.length(h, markers, scale=scale, fudge.bp=fudge.bp))
+ if ("bp"==scale | "Mb"==scale)
+ {
+ one.base <- ifelse("Mb"==scale, 1e-6, 1)
+ r[,2] <- r[,2]-one.base
+ }
+ rownames(r) <- markers
+ colnames(r) <- c("begin","end")
+ return (r)
+}
+
+
+happy.get.intervals <- function(h, chromosome=NULL)
+{
+ happy.get.markers(h, chromosome=chromosome, as.intervals=TRUE)
+}
+
+happy.get.intervals.in.range <- function(h,
+ from = NULL,
+ to = NULL,
+ markers = NULL,
+ chromosome = NULL,
+ scale = "interval")
+{
+ ## deal with requests for all markers or all chromosome markers...
+ if (is.null(from) & is.null(to))
+ {
+ return ( happy.get.markers(h, chromosome=chromosome) )
+ }
+
+ ## calculate range
+
+ if (is.null(chromosome) & "interval"!=scale)
+ {
+ stop("Must specify chromosome= if using ", scale, "\n")
+ }
+
+ # specify start of range
+ marker1 <- NULL
+ if (is.null(from))
+ {
+ marker1 <- happy.get.first.marker(h, chromosome=chromosome)
+ }
+ else
+ {
+ if ("interval"==scale)
+ {
+ if (!happy.has.markers(h, from))
+ {
+ stop("Could not find marker ", from, "\n")
+ }
+ marker1 <- from
+ }
+ else
+ {
+ marker1 <- happy.get.interval.over(h,
+ chromosome=chromosome,
+ x=from,
+ scale=scale,
+ use.nearest.terminus=TRUE)
+ }
+ }
+
+ # specify end of range
+ marker2 <- NULL
+ if (is.null(from))
+ {
+ marker2 <- happy.get.last.marker(h, chromosome=chromosome)
+ }
+ else
+ {
+ if ("interval"==scale)
+ {
+ if (!happy.has.markers(h, to))
+ {
+ stop("Could not find marker ", to, "\n")
+ }
+ marker2 <- to
+ }
+ else
+ {
+ marker2 <- happy.get.interval.over(h,
+ chromosome=chromosome,
+ x=to,
+ scale=scale,
+ use.nearest.terminus=TRUE)
+ }
+ }
+ happy.get.markers.between(h, from=marker1, to=marker2)
+}
+
+
+happy.get.last.marker <- function(h, chromosome=NULL, as.intervals=TRUE)
+{
+ m <- happy.get.markers(h, chromosome=chromosome, as.intervals=as.intervals)
+ m[length(m)]
+}
+
+happy.get.location <- function(h,markers, scale="bp")
+{
+ switch(scale,
+ bp = happy.get.bp(h, markers),
+ Mb = happy.get.bp(h, markers)/1e6,
+ cM = happy.get.position(h, markers))
+}
+
+happy.get.markers.between <- function(h, to=NULL, from=NULL, before=NULL,
+ after=NULL,
+ as.intervals=TRUE)
+# return all markers between two specified markers
+{
+ if (1<length(to) | 1<length(from) | 1<length(before) | 1<length(after))
+ {
+ stop("Arguments must be of length 1\n")
+ }
+
+ markers <- happy.get.markers(h, as.intervals=as.intervals)
+
+ start <- NA
+ if (!is.null(after))
+ {
+ start <- which(after==markers) + 1
+ }
+ else if (!is.null(from))
+ {
+ start <- which(from==markers)
+ }
+
+ end <- NA
+ if (!is.null(before))
+ {
+ end <- which(before==markers) - 1
+ }
+ else if (!is.null(to))
+ {
+ end <- which(to==markers)
+ }
+ if (!force.logical(start) | !force.logical(end))
+ {
+ stop("Could not find start and end points for markers from=",
+ from,", to=",to,", before=",before,", after=",after,"\n" )
+ }
+ markers[start:end]
+}
+
+
+happy.get.next.marker <- function(h, markers, as.intervals=TRUE, within.chr=FALSE)
+# TODO: fix the fact that chr 10 right after chr 1
+{
+ found <- happy.has.markers(h, markers)
+ if (!all(found))
+ {
+ stop("No such markers: ", paste(markers[!found], collapse=", "), "\n")
+ }
+ if (within.chr)
+ {
+ out <- character(length(markers))
+ for (i in 1:length(markers))
+ {
+ chr.markers <- happy.get.markers(h,
+ as.intervals=as.intervals,
+ chr=happy.get.chromosome(h, markers[i]))
+ mi <- match(markers[i], chr.markers)
+ out[i] <- chr.markers[mi+1]
+ }
+ return (out)
+ }
+ else
+ {
+ all.markers <- happy.get.markers(h, as.intervals=as.intervals)
+ mi <- match(markers, all.markers)
+ return (all.markers[mi+1])
+ }
+}
+
+
+happy.get.previous.marker <- function(h, marker, as.intervals=TRUE)
+{
+ markers <- happy.get.markers(h, as.intervals=as.intervals)
+ i <- match(marker, markers)
+ if (any(is.na(i)))
+ {
+ stop("No such markers: ", paste(marker[which(is.na(i))], collapse=", "), "\n")
+ }
+ if (any(1==i))
+ {
+ stop("No marker previous to ", markers[1==i], "\n")
+ }
+ markers[i-1]
+}
+
+
+happy.has.chromosomes <- function(h, chroms, model="genotype")
+{
+ chroms %in% happy.list.chromosomes(h, model=model)
+}
+
+happy.has.subjects <- function(h, subjects)
+{
+ subjects %in% happy.get.subjects(h)
+}
+
+
+happy.has.markers <- function(h, markers, model="additive")
+{
+ markers %in% happy.get.markers(h, model=model)
+}
+
+
+happy.list.chromosomes <- function(h, sort=TRUE, model="genotype")
+{
+ assert.happy(h)
+ chr <- unique(as.character(h[[model]]$genome$chromosome))
+ if (sort)
+ {
+ ints <- suppressWarnings(as.integer(chr))
+ chars <- chr[is.na(ints)]
+ ints <- ints[!is.na(ints)]
+ chr <- c(as.character(sort(ints)), sort(chars))
+ }
+ chr
+}
+
+happy.make.colnames <- function(strain.names, model)
+{
+ if (!is.character(strain.names))
+ {
+ stop("Must pass strain.names as character vector to happy.make.colnames()\n")
+ }
+
+ num.strains <- length(strain.names)
+
+ if ("additive"==model)
+ {
+ return (strain.names)
+ }
+ if ("genotype"==model)
+ {
+ return (NULL)
+ }
+
+ diplotype.names <- matrix(
+ kronecker(strain.names, strain.names, paste, sep = "."),
+ nrow = num.strains)
+ if ("full"==model)
+ {
+ return ( c(diag(diplotype.names),
+ diplotype.names[upper.tri(diplotype.names, diag = FALSE)])
+ )
+ }
+ if ("full.asymmetric"==model)
+ # assumes row major order, ie, (row1, row2, etc), in C object
+ {
+ return (c(t(diplotype.names)))
+ }
+ else
+ {
+ stop("No colnames defined for model ", model, "\n")
+ }
+}
+
+happy.num.strains<-function(h)
+{
+ length(happy.get.strains(h))
+}
+
diff --git a/R/read.happy.genotype.R b/R/read.happy.genotype.R
new file mode 100644
index 0000000..305cfd0
--- /dev/null
+++ b/R/read.happy.genotype.R
@@ -0,0 +1,66 @@
+genotype.to.factor <- function(g)
+{
+ unphased <- rep(NA, length=nrow(g))
+
+ ok <- complete.cases(g)
+ ordered <- g[,1] <= g[,2]
+
+ mask <- ordered & ok
+ unphased[mask] <- paste(g[mask,1], g[mask,2], sep="_")
+
+ mask <- !ordered & ok
+ unphased[mask] <- paste(g[mask,1], g[mask,2], sep="_")
+
+ as.factor(unphased)
+}
+
+genotype.to.count <- function(g)
+{
+ unique.g <- unique(c(na.omit(as.character(g))))
+ if (any(2!=nchar(unique.g)))
+ {
+ stop("Genotypes must be 2 characters long or NA\n")
+ }
+
+ alleles <- unique(unlist(strsplit(unique.g, "")))
+ if (2 < length(alleles))
+ {
+ stop("Cannot interpret genotype as additive with than >2 alleles\n")
+ }
+
+ count <- rep(NA, length(g))
+ count[g==paste(alleles[1],alleles[1],sep="")] <- 0
+
+ if (2==length(alleles))
+ {
+ count[g==paste(alleles[2], alleles[1], sep="")] <- 1
+ count[g==paste(alleles[1], alleles[2], sep="")] <- 1
+ count[g==paste(alleles[2], alleles[2], sep="")] <- 2
+ }
+ return (count)
+}
+
+genotype.to.hier <- function(g)
+{
+ g <- genotype.to.count(g)
+
+ lo <- g==0
+ het <- g==1
+ hi <- g==2
+
+ # use parameterization of Cordell
+
+ # x describes additive contribution only
+ x <- rep(NA, length(g))
+ x[lo] <- -1
+ x[het] <- 0
+ x[hi] <- 1
+
+ # z describes dominance contribution only
+ z <- rep(NA, length(g))
+ z[lo] <- -0.5
+ z[het] <- 1
+ z[hi] <- -0.5
+
+ return (data.frame(additive=x, dominance=z))
+}
diff --git a/R/read.happy.reserve.R b/R/read.happy.reserve.R
new file mode 100644
index 0000000..69e9d19
--- /dev/null
+++ b/R/read.happy.reserve.R
@@ -0,0 +1,103 @@
+
+
+happy.init.reserve <- function(h,
+ memory.limit.Mb=Inf,
+ models=happy.get.models(h),
+ auto.reserve=TRUE,
+ allow.scratch=TRUE)
+{
+ h$DATA <- list()
+ if (allow.scratch)
+ {
+ models=c(models, "scratch")
+ }
+ for (m in models)
+ {
+ h$DATA[[m]] <- new.hash()
+ }
+ h$DATA.MAX.MEMORY <- memory.limit.Mb*2^20
+ h$DATA.AUTO.ADD <- auto.reserve
+ h
+}
+
+happy.clear.reserve <- function(h)
+{
+ h$DATA=NULL
+ h$DATA.MAX.MEMORY=NULL
+ h$DATA.AUTO.ADD=NULL
+ h
+}
+
+happy.is.auto.reserve <- function(h)
+{
+ if (is.null(h$DATA.AUTO.ADD)) return (FALSE)
+ h$DATA.AUTO.ADD
+}
+
+happy.reserve.has.scratch <- function(h)
+{
+ !is.null(h$DATA[["scratch",exact=TRUE]])
+}
+
+happy.get.reserve.limit <- function(h)
+{
+ h$DATA.MAX.MEMORY
+}
+
+happy.set.auto.reserve <- function(h, bool)
+{
+ h$DATA.AUTO.ADD <- bool
+ h
+}
+
+#---CORE RESERVE ACCESS FUNCTIONS---
+
+happy.reserve.exists <- function(h)
+{
+ !is.null(h$DATA)
+}
+
+happy.reserve.memory.usage <- function(h)
+{
+ if (!happy.reserve.exists(h))
+ {
+ stop("Reserve does not exist!\n")
+ }
+ sum(sapply(h$DATA, hash.memory.usage))
+}
+
+happy.reserve.get <- function(h, category, object.name)
+{
+ hash.get(h$DATA[[category, exact=TRUE]], object.name)
+}
+
+happy.reserve.has <- function(h, category, object.name=NULL)
+{
+ if (!happy.reserve.exists(h))
+ {
+ return(FALSE)
+ }
+ if (is.null(h[["DATA", exact=TRUE]][[category, exact=TRUE]]))
+ {
+ return (FALSE)
+ }
+ if (is.null(object.name))
+ {
+ return (TRUE)
+ }
+ hash.has(h$DATA[[category, exact=TRUE]], object.name)
+}
+
+happy.reserve.put <- function(h, category, object.name, object)
+{
+ if (!happy.reserve.exists(h))
+ {
+ stop("Cannot reserve object because reserve is not initialized\n")
+ }
+ if (is.null(h$DATA[[category, exact=TRUE]]))
+ {
+ stop("Cannot reserve object because category ", category, " does not exist\n")
+ }
+ hash.put(h$DATA[[category, exact=TRUE]], object.name, object)
+}
+
diff --git a/R/unify.R b/R/unify.R
new file mode 100644
index 0000000..52c91da
--- /dev/null
+++ b/R/unify.R
@@ -0,0 +1,458 @@
+
+hasS3method <- function(f, x)
+# checks whether there is an S3 method f for class or object x
+{
+ if(is.object(x)) x <- oldClass(x)
+ !is.null(getS3method(f, x, optional=TRUE))
+}
+
+hasS4method <- function(f, x)
+# checks whether there is an S4 method f for class or object x
+{
+ if (is.object(x)) x <- class(x)
+ for (cl in x)
+ {
+ m <- selectMethod(f, optional=TRUE, signature=signature(object=cl))
+ if (!is.null(m)) return (TRUE)
+ }
+ FALSE
+}
+
+
+unify.aic <- function(object)
+{
+ 2 * unify.num.params(object) - 2* unify.logLik(object)
+}
+
+# promises to return a data frame with at least the following columns
+# predictor
+# pvalue
+# logP
+# pctvar
+unify.anova <- function(object, test=NULL, ...){
+ retval <- NULL
+ make.dummy.anova <- function(object)
+ {
+ predictors <- c("NULL", colnames(attr(terms(object), "factors")))
+ data.frame(
+ predictors = predictors,
+ pvalue = rep(NA, length(predictors)),
+ logP = rep(NA, length(predictors)),
+ pctvar = rep(NA, length(predictors)))
+ }
+
+ if (inherits(object, "glm"))
+ {
+ if (is.null(test)) test <- "Chisq"
+ an <- anova(object, test=test)
+ add <- data.frame(predictor=rownames(an), pvalue=an$"P(>|Chi|)")
+ add$logP <- -log10(add$pvalue)
+ add$pctvar <- NA
+ retval <- cbind(an, add)
+ }
+ else if (inherits(object, "lm"))
+ {
+ if (is.null(test)) test <- "F"
+ pname <- switch(test, F="Pr(>F)", NA)
+ if (is.na(test)) test <- NULL
+
+ an <- anova(object, test=test)
+ add <- data.frame(predictor=rownames(an), pvalue=an[,pname])
+ add$logP <- -log10(add$pvalue)
+
+ # pctvar calculation
+ tss <- SS(fitted(object)+residuals(object))
+ add$pctvar <- an$"Sum Sq"/tss * 100
+
+ retval <- cbind(an, add)
+ }
+ else if (inherits(object, "survreg")
+ | inherits(object, "coxph")
+ | inherits(object, "polr")
+ | inherits(object, "lmer")
+ | inherits(object, "glmer")
+ | inherits(object, "mer")
+ )
+ {
+ retval <- make.dummy.anova(object)
+ }
+ else
+ {
+ stop("No unify.anova() for objects of class ",
+ paste(class(object), collapse="/"), "\n")
+ }
+ retval
+}
+
+# promises to return a data frame with at least the following columns
+# formula
+# df.residual
+# residual.deviance
+# df
+# delta.deviance
+# test
+# pvalue
+# logP
+unify.anova.list <- function(..., test=NULL)
+{
+ unify.anova.list.lrt <- function(x, sort=FALSE)
+ {
+ if (sort)
+ {
+ x <- x[order(x$df),]
+ }
+
+ x$delta.deviance <- c(NA, diff(-x$residual.deviance))
+ x$test <- c(NA,rep("Chisq",nrow(x)-1))
+ x$pvalue <- c(NA, pchisq(x$delta.deviance[-1], df = diff(x$df),
+ lower.tail = FALSE))
+ x$logP <- -log10(x$pvalue)
+ x
+ }
+
+ ## main function
+ objects <- list(...)
+ retval <- NULL
+ if (inherits(objects[[1]], "negbin"))
+ {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,
+ function(x){ formula.as.string(x$terms) }, simplify=TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- retval$"Resid. df" - 1
+ retval$residual.deviance <- - retval$" 2 x log-lik."
+ nobs <- sapply(objects, function(x){ length(resid(x)) }, simplify=TRUE)
+ retval$df <- nobs - retval$df.residual
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "glm"))
+ {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,
+ function(x){ formula.as.string(x$terms) }, simplify=TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- retval$"Resid. Df"
+ retval$residual.deviance <- retval$"Resid. Dev"
+ nobs <- sapply(objects, function(x){ length(resid(x)) }, simplify=TRUE)
+ retval$df <- nobs - retval$df.residual
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "lm"))
+ {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,
+ function(x){ formula.as.string(x$terms) }, simplify=TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- retval$Res.Df
+ retval$residual.deviance <- retval$RSS # deviance == RSS, p141 V&R
+ nobs <- sapply(objects, function(x){ length(resid(x)) }, simplify=TRUE)
+ retval$df <- nobs - retval$df.residual
+ retval$delta.deviance <- retval$"Sum of Sq"
+ retval$test <- "F"
+ retval$pvalue <- retval$"Pr(>F)"
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "survreg"))
+ {
+ for (k in 1:length(objects))
+ {
+ obj <- objects[[k]]
+ add <- data.frame(
+ formula = formula.as.string(as.formula(obj$terms)),
+ residual.deviance = unify.deviance(obj),
+ df.residual = obj$df.residual,
+ df = obj$df)
+ retval <- rbind(retval, add)
+ }
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "coxph"))
+ {
+ for (k in 1:length(objects))
+ {
+ obj <- objects[[k]]
+ add <- data.frame(
+ formula = formula.as.string(as.formula(obj$terms)),
+ residual.deviance = unify.deviance(obj),
+ df.residual = obj$n - sum(!is.na(coef(obj))), # not quite right!
+ df = sum(!is.na(coef(obj)))) # not quite right!
+ retval <- rbind(retval, add)
+ }
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "polr"))
+ {
+ for (k in 1:length(objects))
+ {
+ obj <- objects[[k]]
+ add <- data.frame(
+ formula = formula.as.string(as.formula(obj$terms)),
+ residual.deviance = unify.deviance(obj),
+ df.residual = obj$df.residual,
+ df = obj$edf)
+ retval <- rbind(retval, add)
+ }
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "merMod")){
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,
+ function(x){ formula.as.string(attr(x at frame, "formula")) }, simplify=TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$"Pr(>Chisq)"
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "glmer"))
+ {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,
+ function(x){ formula.as.string(x at terms) }, simplify=TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$"Pr(>Chisq)"
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "mer"))
+ {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,function(x){ formula.as.string(terms(x)) }, simplify=TRUE)
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$Pr
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "lmer"))
+ {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects,function(x){ formula.as.string(terms(x)) }, simplify=TRUE)
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$Pr
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else
+ {
+ warning("Unrecognized class ", class(objects[[1]]), "in unify anova list\n")
+ retval <- anova(...)
+ }
+ rownames(retval) <- 1:nrow(retval)
+
+ # set same vs same fit comparisons to p=1
+ zeros <- which(0==retval$delta.deviance & !is.finite(retval$pvalue))
+ retval$pvalue[zeros] <- 1
+ retval$logP[zeros] <- 0
+
+ retval
+}
+
+unify.bic <- function(object, k=unify.num.params(object))
+{
+ k * log(unify.num.obs(object)) - 2* unify.logLik(object)
+}
+
+unify.deviance <- function(object)
+# promises to return the deviance, either via deviance() or
+# from the log liklihood
+{
+ if (inherits(object, "mer"))
+ {
+ return (deviance(object, REML=FALSE))
+ }
+ else if (hasS3method("deviance", object) | hasS4method("deviance", object))
+ {
+ return (deviance(object))
+ }
+ -2*unify.logLik(object)
+}
+
+unify.logLik <- function(object){
+ retval <- NULL
+ if (inherits(object, "survreg") | inherits(object, "coxph")){
+ retval <- object$loglik[2]
+ }
+ else if (inherits(object, "mer") | inherits(object, "merMod")){
+ retval <- as.numeric(logLik(object, REML=FALSE))
+ }
+ else{
+ retval <- as.numeric(logLik(object))
+ }
+ retval
+}
+
+unify.generic.model.type <- function(x)
+{
+ lookup <- unify.model.types()
+ unlist(lookup)[match(x, names(lookup))]
+}
+
+unify.has.model.type <- function(x)
+# returns TRUE for model types that the unify functions know about
+{
+ x %in% names(unify.model.types())
+}
+
+
+unify.is.multilevel.formula <- function(form)
+# returns TRUE if formula contains lmer-style conditioning symbol "|"
+{
+ if (is.null(form)) return (FALSE)
+ if (1<length(form))
+ {
+ return ( apply(as.array(form), 1, unify.is.multilevel.formula) )
+ }
+
+ if (!is.formula(form)) { if (is.na(form)) return (FALSE) }
+ return ( 0<length(grep(pattern="\\|", formula.as.string(form))) )
+}
+
+unify.model.types <- function()
+# list model types and generic names for models that the unify
+# functions know about
+{
+ synonyms <- list(
+ binary = "binomial",
+ binomial = "binomial",
+ coxph = "coxph",
+ Gamma = "Gamma",
+ gamma = "Gamma",
+ gaussian = "gaussian",
+ linear = "gaussian",
+ negative.binomial = "negative.binomial",
+ negbin = "negative.binomial",
+ ordinal = "polr",
+ overdispersed.poisson = "negative.binomial",
+ poisson = "poisson",
+ polr = "polr",
+ quasipoisson = "quasipoisson",
+ survival = "survreg",
+ survreg = "survreg")
+}
+
+unify.num.obs <- function(object)
+{
+ ll <- logLik(object)
+ as.numeric(attr(ll, "nobs"))
+}
+
+unify.num.params <- function(object)
+{
+ ll <- logLik(object)
+ as.numeric(attr(ll, "df"))
+}
+
+# unify different model fitting procedures
+unify.fit <- function(formula, data, model.type="linear", args=list())
+{
+ form <- as.formula(formula)
+
+ is.multilevel <- 0<length(grep(pattern="\\|", formula.as.string(form)))
+
+ type <- unify.model.types()[[model.type]]
+ if (is.null(type)){
+ stop("Cannot currently fit models of type ", model.type ,"\n")
+ }
+
+ fit <- NULL
+ if (!is.multilevel) {
+ args$formula <- formula
+ args$data <- quote(data)
+ if ("gaussian"==type) {
+ fit <- do.call("lm", args=args)
+ }
+ else if (type %in% c("binomial", "Gamma", "poisson", "quasipoisson")) {
+ args$family <- type
+ fit <- do.call("glm", args=args)
+ }
+ else if ("negative.binomial"==type) {
+ fit <- do.call("glm.nb", args=args)
+ }
+ else if ("survreg"==type) {
+ fit <- do.call("survreg", args=args)
+ }
+ else if ("coxph"==type) {
+ fit <- do.call("coxph", args=args)
+ }
+ else if ("polr"==type) {
+ fit <- do.call("polr", args=args)
+ }
+ else {
+ stop("Cannot fit unilevel model.type ", model.type, "\n")
+ }
+ }
+ else {
+ require(lme4)
+ args$formula <- formula
+ args$data <- quote(data)
+ args$REML <- FALSE # 2015-05-19
+ if ("gaussian"==type) {
+ fit <- do.call("lmer", args=args)
+ }
+ else if (type %in% c("binomial", "Gamma", "poisson", "quasipoisson")) {
+ args$family <- type
+ fit <- do.call("lmer", args=args)
+ }
+ else {
+ stop("Cannot fit multilevel model.type ", model.type, "\n")
+ }
+ }
+ fit
+}
+
+unify.simulate <- function(object, ...){
+ if (inherits(object, "mer")|inherits(object, "merMod")){
+ return ( unify.simulate.lmer(object, ...) )
+ }
+ else if (inherits(object, "glm")){
+ type <- attr(object, "family")$family
+ if (type %in% c("binomial", "poisson")) {
+ return (simulate(object, ...))
+ }
+ else {
+ stop("Cannot currently simulate from ", type, " glm model\n")
+ }
+ }
+ else if (inherits(object, "lm")){
+ return (simulate(object, ...))
+ }
+ else{
+ stop("Cannot currently simulate from model of type ",
+ class(object), "\n")
+ }
+}
+
+unify.simulate.lmer <- function(object, ...){
+ return ( simulate(object, ...) )
+
+ # IN PROGRESS!!!!
+ #type <- attr(object, "family")$family
+ if ("binomial"==type) {
+ out <- simulate(object, ...)
+# if (!is.null(attr(object, "weights")))
+# # simulate binomial proportions
+# {
+# out <- out / attr(object, "weights")
+# }
+ return (out)
+ }
+ if ("poisson"==type) {
+ return (simulate(object, ...))
+ }
+ else {
+ stop("Cannot currently simulate from ", type, " glmer model\n")
+ }
+}
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 956ed0b..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,6 +0,0 @@
-r-other-valdar-bagpipe.backend (0.34-1) UNRELEASED; urgency=low
-
- * initial version (Closes: #XXXXXX)
-
- -- Thorsten Alteholz <debian at alteholz.de> Tue, 09 Apr 2013 18:00:07 +0200
-
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index f599e28..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-10
diff --git a/debian/control b/debian/control
deleted file mode 100644
index 35f893a..0000000
--- a/debian/control
+++ /dev/null
@@ -1,34 +0,0 @@
-Source: r-other-valdar-bagpipe.backend
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Thorsten Alteholz <debian at alteholz.de>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 10),
- r-base-dev,
- r-cran-evd,
- r-cran-bitops
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-other-valdar-bagpipe.backend/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-other-valdar-bagpipe.backend/trunk/
-Homepage: http://valdarlab.unc.edu/software/bagpipe/_build/html/bagpipe.html
-
-Package: r-other-valdar-bagpipe.backend
-Architecture: any
-Depends: ${shlibs:Depends},
- ${R-Depends},
- ${misc:Depends}
-Recommends: ${R:Recommends}
-Suggests: ${R:Suggests}
-Description: core R functions for fitting models in bagpipe
- The package allows one to compose general HTTP requests and provides
- convenient functions to fetch URIs, get & post forms, etc. and process
- the results returned by the Web server. This provides a great deal of
- control over the HTTP/FTP/... connection and the form of the request
- while providing a higher-level interface than is available just using
- R socket connections. Additionally, the underlying implementation is
- robust and extensive, supporting FTP/FTPS/TFTP (uploads and downloads),
- SSL/HTTPS, telnet, dict, ldap, and also supports cookies, redirects,
- authentication, etc.
- .
- The package has its origin at omegahat.org and it is also found at
- bioconductor.org.
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 134dad1..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/usr/bin/make -f
-
-%:
- dh $@ --buildsystem R
-
-get-orig-source:
- mkdir -p ../tarballs
- uscan --verbose --force-download --destdir=../tarballs
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index 8c3a990..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=3
-http://valdarlab.unc.edu/software/bagpipe/_build/html/bagpipe.html http://valdarlab.unc.edu/software/bagpipe/install/bagpipe.backend_([\d.]+)\.tar\.gz
-
diff --git a/man/DEFAULT.REDUCE.DMAT.CUTOFF.Rd b/man/DEFAULT.REDUCE.DMAT.CUTOFF.Rd
new file mode 100644
index 0000000..9309a51
--- /dev/null
+++ b/man/DEFAULT.REDUCE.DMAT.CUTOFF.Rd
@@ -0,0 +1,28 @@
+\name{DEFAULT.REDUCE.DMAT.CUTOFF}
+\alias{DEFAULT.REDUCE.DMAT.CUTOFF}
+\docType{data}
+\title{DEFAULT.REDUCE.DMAT.CUTOFF
+%% ~~ data name/kind ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of the dataset. ~~
+}
+\usage{data(DEFAULT.REDUCE.DMAT.CUTOFF)}
+\format{
+ The format is:
+ num 0.01
+}
+\details{
+%% ~~ If necessary, more details than the __description__ above ~~
+}
+\source{
+%% ~~ reference to a publication or URL from which the data were obtained ~~
+}
+\references{
+%% ~~ possibly secondary sources and usages ~~
+}
+\examples{
+data(DEFAULT.REDUCE.DMAT.CUTOFF)
+## maybe str(DEFAULT.REDUCE.DMAT.CUTOFF) ; plot(DEFAULT.REDUCE.DMAT.CUTOFF) ...
+}
+\keyword{datasets}
diff --git a/man/DiploprobReader-class.Rd b/man/DiploprobReader-class.Rd
new file mode 100644
index 0000000..f070074
--- /dev/null
+++ b/man/DiploprobReader-class.Rd
@@ -0,0 +1,82 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/DiploprobReaderClass.R
+\docType{class}
+\name{DiploprobReader-class}
+\alias{DiploprobReader}
+\alias{DiploprobReader-class}
+\title{Class for a DiploprobReader object}
+\description{
+Class for a DiploprobReader object
+}
+\section{Methods}{
+
+\describe{
+\item{\code{getChromLength(chrom, scale)}}{Returns the length of the specified chromosome in units of the specified scale}
+
+\item{\code{getChromList()}}{Returns a character vector of the chromosome names}
+
+\item{\code{getChromOfLocus(loci)}}{Returns a character vector containing the name(s) of the chromosome(s) to which the specified loci belong}
+
+\item{\code{getFirstLocus(chrom)}}{Returns the name of the first locus on the specified chromosome}
+
+\item{\code{getFounders()}}{Returns a character vector of the founder names}
+
+\item{\code{getGenotype(marker, ...)}}{Returns a vector containing the genotypes observed for the specified marker, with NA for
+missing genotypes}
+
+\item{\code{getLastLocus(chrom)}}{Returns the name of the last locus on the specified chromosome}
+
+\item{\code{getLoci(chrom = NULL, before = NULL, after = NULL, from = NULL,
+ to = NULL, scale = "interval", over = NULL)}}{Returns a character vector of the locus names}
+
+\item{\code{getLocusMatrix(locus, model, subjects = NULL, as.data.frame = FALSE,
+ sdp = NULL)}}{Get matrix representing average probabilities or expectations of haplotypes
+over the interval}
+
+\item{\code{getLocusProbTensor(locus, model, subjects = NULL, simplify = FALSE,
+ memoize.last = TRUE)}}{For n subjects descended from J strains, this function returns a tensor
+of n JxJ matrices. Each matrix gives the probability that a randomly
+chosen point within the locus interval is descended from a particular diplotype.
+
+model: When model = full.asymmetric, the diplotype probability matrix distinguishes
+between diplotype AB and BA for founders A and B. When model = full, these
+probabilities are set to be equal. Depending on how the HMM probabilities were
+estimated, full.asymmetric may not be available.
+
+simplify: When simplify=TRUE and only one subject is specified, the return value is
+simplified from a 1xJxJ tensor to a JxJ matrix.
+
+memoize.last: An optimization for when it is expected that the same tensor will be
+requested repeatedly. Setting memoize.last=TRUE causes the method to make
+an internal cache of the last return value. If the exact same tensor is requested,
+then the method returns the cached value, thereby avoiding the cost of repeating
+various operations that may include file I/O.}
+
+\item{\code{getLocusRange(loci, scale)}}{Returns the left and right boundaries of the specified loci, in units of the specified scale}
+
+\item{\code{getLocusWidth(loci, scale)}}{Returns a numeric vector containing, for each specified locus, the left-to-right width in the
+units of the specified scale}
+
+\item{\code{getMarkerLocation(markers, scale)}}{Returns the location of the specified marker(s) in units of the specified scale}
+
+\item{\code{getMarkers()}}{}
+
+\item{\code{getNextMarker(markers)}}{Returns the next marker along, or NA if at the end of the chromosome}
+
+\item{\code{getNumFounders()}}{Returns the number of founders}
+
+\item{\code{getNumSubjects()}}{Returns the number of subjects}
+
+\item{\code{getSubjects()}}{Returns a character vector of the subject names}
+
+\item{\code{hasChrom(chrom)}}{Returns logical vector indicating whether the specified chromosomes exist}
+
+\item{\code{hasLoci(loci)}}{Returns logical vector indicating whether loci with the specified names exist}
+
+\item{\code{hasMarkers(markers)}}{Returns logical vector indicating whether markers with the specified names exist. Compare $hasLoci()$.}
+
+\item{\code{hasSubjects(subjects)}}{Returns logical vector indicating whether subjects with the specified names exist}
+
+\item{\code{updateBp(markerBpTable, allowPartial = FALSE)}}{Update base pair positions of the markers. Handy when bp positions were unavailable or misspecified at the time of generating the genome cache. $markerBpTable$ is a data.frame with two columns: the first should have the locus name, the second should have the bp position. $allowPartial$ permits updating of a subset of the markers; by default this is set to FALSE.}
+}}
+
diff --git a/man/ENV.Rd b/man/ENV.Rd
new file mode 100644
index 0000000..f8c0608
--- /dev/null
+++ b/man/ENV.Rd
@@ -0,0 +1,56 @@
+\name{ENV}
+\alias{ENV}
+\title{Substitute shell variables for their values in character strings.
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+ENV(...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (...)
+{
+ interpolate.Sys.env(...)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/SS.Rd b/man/SS.Rd
new file mode 100644
index 0000000..53c0ce5
--- /dev/null
+++ b/man/SS.Rd
@@ -0,0 +1,58 @@
+\name{SS}
+\alias{SS}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{SS
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+SS(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ cov(x, x) * (length(x) - 1)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/apply.permutation.matrix.Rd b/man/apply.permutation.matrix.Rd
new file mode 100644
index 0000000..58a1320
--- /dev/null
+++ b/man/apply.permutation.matrix.Rd
@@ -0,0 +1,72 @@
+\name{apply.permutation.matrix}
+\alias{apply.permutation.matrix}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{apply.permutation.matrix
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+apply.permutation.matrix(original.response, perm.matrix)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{original.response}{
+%% ~~Describe \code{original.response} here~~
+}
+ \item{perm.matrix}{
+%% ~~Describe \code{perm.matrix} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (original.response, perm.matrix)
+{
+ responses.list <- list()
+ for (i in 1:ncol(perm.matrix)) {
+ if (is.data.frame(original.response)) {
+ responses.list[[i]] <- original.response[perm.matrix[,
+ i], ]
+ }
+ else {
+ responses.list[[i]] <- original.response[perm.matrix[,
+ i]]
+ }
+ }
+ responses.list
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/apply.transform.Rd b/man/apply.transform.Rd
new file mode 100644
index 0000000..a40ea24
--- /dev/null
+++ b/man/apply.transform.Rd
@@ -0,0 +1,65 @@
+\name{apply.transform}
+\alias{apply.transform}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{apply.transform
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+apply.transform(formula, data)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{formula}{
+%% ~~Describe \code{formula} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (formula, data)
+{
+ if (!is.character(formula)) {
+ formula <- as.character(deparse(formula))
+ }
+ response <- sub("~.*", "", formula)
+ eval(parse(text = response), env = data)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/assert.happy.Rd b/man/assert.happy.Rd
new file mode 100644
index 0000000..dc04a60
--- /dev/null
+++ b/man/assert.happy.Rd
@@ -0,0 +1,59 @@
+\name{assert.happy}
+\alias{assert.happy}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{assert.happy
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+assert.happy(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ if (!inherits(h, "happy.genome")) {
+ stop("Object must be of class happy.genome\n")
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.backend-package.Rd b/man/bagpipe.backend-package.Rd
new file mode 100644
index 0000000..badca9d
--- /dev/null
+++ b/man/bagpipe.backend-package.Rd
@@ -0,0 +1,43 @@
+\name{bagpipe.backend-package}
+\alias{bagpipe.backend-package}
+\alias{bagpipe.backend}
+\docType{package}
+\title{bagpipe.backend-package
+What the package does (short line)
+~~ package title ~~
+}
+\description{
+More about what it does (maybe more than one line)
+~~ A concise (1-5 lines) description of the package ~~
+}
+\details{
+\tabular{ll}{
+Package: \tab bagpipe.backend\cr
+Type: \tab Package\cr
+Version: \tab 1.0\cr
+Date: \tab 2011-05-23\cr
+License: \tab What license is it under?\cr
+LazyLoad: \tab yes\cr
+}
+~~ An overview of how to use the package, including the most important ~~
+~~ functions ~~
+}
+\author{
+Who wrote it
+
+Maintainer: Who to complain to <yourfault at somewhere.net>
+~~ The author and/or maintainer of the package ~~
+}
+\references{
+~~ Literature or other references for background information ~~
+}
+~~ Optionally other standard keywords, one per line, from file KEYWORDS in ~~
+~~ the R documentation directory ~~
+\keyword{ package }
+\seealso{
+~~ Optional links to other man pages, e.g. ~~
+~~ \code{\link[<pkg>:<pkg>-package]{<pkg>}} ~~
+}
+\examples{
+~~ simple examples of the most important functions ~~
+}
diff --git a/man/bagpipe.data.error.Rd b/man/bagpipe.data.error.Rd
new file mode 100644
index 0000000..27ad67a
--- /dev/null
+++ b/man/bagpipe.data.error.Rd
@@ -0,0 +1,58 @@
+\name{bagpipe.data.error}
+\alias{bagpipe.data.error}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.data.error
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.data.error(...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (...)
+{
+ stop("Bagpipe Data Error: ", ..., "\n", call. = FALSE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.define.posboot.loci.Rd b/man/bagpipe.define.posboot.loci.Rd
new file mode 100644
index 0000000..9b636b7
--- /dev/null
+++ b/man/bagpipe.define.posboot.loci.Rd
@@ -0,0 +1,77 @@
+\name{bagpipe.define.posboot.loci}
+\alias{bagpipe.define.posboot.loci}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.define.posboot.loci
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.define.posboot.loci(h, locus.range)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{locus.range}{
+%% ~~Describe \code{locus.range} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, locus.range)
+{
+ if (2 != length(locus.range)) {
+ bagpipe.input.error("Must specify exactly two markers for positional bootstrap")
+ }
+ if (!all(happy.has.markers(h, locus.range))) {
+ bagpipe.input.error("Unknown markers:", paste(locus.range[!happy.has.markers(h,
+ locus.range)], collapse = ","))
+ }
+ if (1 != length(unique(happy.get.chromosome(h, locus.range)))) {
+ bagpipe.input.error(paste(sep = "", "Cannot bootstrap between unlinked markers ",
+ locus.range[1], " (chr ", happy.get.chromosome(h,
+ locus.range[1])), ") and ", locus.range[2], " (chr ",
+ happy.get.chromosome(h, locus.range[2]), ")")
+ }
+ if (0 > diff(happy.get.location(h, locus.range, scale = "cM"))) {
+ bagpipe.input.error("Markers for positional bootstrap must in given in chromosome order")
+ }
+ happy.get.markers.between(h, from = locus.range[1], to = locus.range[2])
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.expand.formula.Rd b/man/bagpipe.expand.formula.Rd
new file mode 100644
index 0000000..a3da79f
--- /dev/null
+++ b/man/bagpipe.expand.formula.Rd
@@ -0,0 +1,204 @@
+\name{bagpipe.expand.formula}
+\alias{bagpipe.expand.formula}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.expand.formula
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.expand.formula(h, formulae, subjects = happy.get.subjects(h), add.THE.LOCUS = FALSE, minus.THE.LOCUS = FALSE, THE.LOCUS = NULL, THE.LOCUS.model = NULL, dmat.transform.FUN = NULL, verbose = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{formulae}{
+%% ~~Describe \code{formulae} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+ \item{add.THE.LOCUS}{
+%% ~~Describe \code{add.THE.LOCUS} here~~
+}
+ \item{minus.THE.LOCUS}{
+%% ~~Describe \code{minus.THE.LOCUS} here~~
+}
+ \item{THE.LOCUS}{
+%% ~~Describe \code{THE.LOCUS} here~~
+}
+ \item{THE.LOCUS.model}{
+%% ~~Describe \code{THE.LOCUS.model} here~~
+}
+ \item{dmat.transform.FUN}{
+%% ~~Describe \code{dmat.transform.FUN} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, formulae, subjects = happy.get.subjects(h), add.THE.LOCUS = FALSE,
+ minus.THE.LOCUS = FALSE, THE.LOCUS = NULL, THE.LOCUS.model = NULL,
+ dmat.transform.FUN = NULL, verbose = FALSE)
+{
+ if (is.null(formulae) | 0 == length(formulae)) {
+ stop("Formulae vector must be non-null and be of non-zero length\n")
+ }
+ if (!is.formula(formulae)) {
+ for (i in 1:length(formulae)) {
+ if (is.formula(formulae[i]))
+ next
+ if (is.na(formulae[i])) {
+ stop("Missing values in formulae[", i, "]\n")
+ }
+ }
+ }
+ formulae <- formula.as.string(formulae)
+ if (0 == length(subjects)) {
+ warning("No subjects requested in bagpipe.expand.formula()!\n")
+ }
+ subjects <- as.character(subjects)
+ if (any(minus.THE.LOCUS)) {
+ if (length(minus.THE.LOCUS) != length(formulae)) {
+ minus.THE.LOCUS = rep(minus.THE.LOCUS, length.out = length(formulae))
+ }
+ formulae[minus.THE.LOCUS] <- drop.formula.vars(formulae[minus.THE.LOCUS],
+ "THE.LOCUS")
+ }
+ if (any(add.THE.LOCUS)) {
+ i <- setdiff(which(add.THE.LOCUS), grep("THE.LOCUS",
+ formulae))
+ formulae[i] <- paste(formulae[i], " + THE.LOCUS", sep = "")
+ }
+ if (!is.null(THE.LOCUS) & !is.null(THE.LOCUS.model)) {
+ THE.LOCUS.model <- rep(THE.LOCUS.model, length.out = length(formulae))
+ for (i in 1:length(formulae)) {
+ if (is.na(THE.LOCUS.model[i]))
+ next
+ locus <- bagpipe.formula.encipher.locus(THE.LOCUS,
+ THE.LOCUS.model[i])
+ formulae[i] <- gsub("THE.LOCUS", locus, formulae[i])
+ }
+ }
+ else if (!is.null(THE.LOCUS) & is.null(THE.LOCUS.model)) {
+ for (i in 1:length(formulae)) {
+ formulae[i] <- gsub("THE.LOCUS", THE.LOCUS, formulae[i])
+ }
+ }
+ ok.subjects <- happy.has.subjects(h, subjects)
+ seen.predictors <- list()
+ for (extractor in bagpipe.formula.extractor.lookup()$extractor) {
+ for (i in 1:length(formulae)) {
+ form <- formulae[i]
+ deciphered <- bagpipe.formula.decipher(form, extractor = extractor)
+ new.formula <- ""
+ for (k in 1:length(deciphered$chunks)) {
+ chunk <- deciphered$chunks[[k]]
+ new.formula <- paste(new.formula, sep = "", chunk$before)
+ locus.name <- chunk$locus.name
+ if (is.null(locus.name)) {
+ break
+ }
+ if ("THE.LOCUS" == locus.name) {
+ new.formula <- paste(new.formula, sep = "",
+ chunk$locus.cipher)
+ next
+ }
+ if (!is.null(seen.predictors[[chunk$predictor.tag,
+ exact = TRUE]])) {
+ new.formula <- paste(new.formula, sep = " ",
+ seen.predictors[[chunk$predictor.tag, exact = TRUE]]$terms.string)
+ next
+ }
+ data <- bagpipe.get.design(h, locus = chunk$locus.name,
+ subjects = subjects[ok.subjects], extractor = extractor,
+ extractor.args = chunk$locus.args, extractor.tag = bagpipe.formula.extractor.lookup(extractor)$tag)
+ if (is.nullOrEmpty(data)) {
+ if (is.null(data)) {
+ browser()
+ stop("Cannot find locus data for ", model,
+ ":", locus.name, " from formula ", form,
+ "\n")
+ }
+ stop("Zero rows of locus data for requested ",
+ length(subjects), " subjects\n")
+ }
+ if (!is.null(dmat.transform.FUN) & 1 < ncol(data)) {
+ data <- as.data.frame(dmat.transform.FUN(data))
+ if (0 == length(grep(chunk$predictor.tag, colnames(data)))) {
+ colnames(data) <- paste(chunk$predictor.tag,
+ sep = ".", colnames(data))
+ }
+ }
+ terms.string <- paste(colnames(data), collapse = " + ")
+ if (1 < ncol(data)) {
+ terms.string <- paste("(", terms.string, ")",
+ sep = "")
+ }
+ new.formula <- paste(new.formula, sep = " ",
+ terms.string)
+ seen.predictors[[chunk$predictor.tag]] <- list(terms.string = terms.string,
+ data = data)
+ }
+ formulae[i] <- paste(new.formula, sep = "", deciphered$tail)
+ }
+ }
+ data <- NULL
+ if (0 != length(seen.predictors)) {
+ for (i in 1:length(seen.predictors)) {
+ if (is.null(data)) {
+ data <- seen.predictors[[i]]$data
+ }
+ else {
+ data <- cbind(data, seen.predictors[[i]]$data)
+ }
+ }
+ }
+ if (!all(ok.subjects) & !is.null(data)) {
+ unpadded.data <- data
+ data <- matrix(nrow = length(ok.subjects), ncol = ncol(unpadded.data),
+ dimnames = list(NULL, colnames(unpadded.data)))
+ data <- as.data.frame(data)
+ data[which(ok.subjects), ] <- unpadded.data
+ }
+ list(formulae = formulae, locus.data = data)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.extract.loci.Rd b/man/bagpipe.extract.loci.Rd
new file mode 100644
index 0000000..4f20110
--- /dev/null
+++ b/man/bagpipe.extract.loci.Rd
@@ -0,0 +1,72 @@
+\name{bagpipe.extract.loci}
+\alias{bagpipe.extract.loci}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.extract.loci
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.extract.loci(h, locus.group)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{locus.group}{
+%% ~~Describe \code{locus.group} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, locus.group)
+{
+ if (locus.group \%in\% happy.list.chromosomes(h)) {
+ return(happy.get.markers(h, chromosome = locus.group))
+ }
+ loci <- scan(locus.group, comment.char = "#", blank.lines.skip = TRUE,
+ what = "character")
+ has.loci <- happy.has.markers(h, loci)
+ if (any(!has.loci)) {
+ stop("Input error: could not find loci ", paste(sep = ",",
+ loci[!has.loci]), "listed in file", locus.group,
+ "\n")
+ }
+ loci
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.formula.decipher.Rd b/man/bagpipe.formula.decipher.Rd
new file mode 100644
index 0000000..fe6cd2c
--- /dev/null
+++ b/man/bagpipe.formula.decipher.Rd
@@ -0,0 +1,88 @@
+\name{bagpipe.formula.decipher}
+\alias{bagpipe.formula.decipher}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.formula.decipher
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.formula.decipher(string, extractor)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{string}{
+%% ~~Describe \code{string} here~~
+}
+ \item{extractor}{
+%% ~~Describe \code{extractor} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (string, extractor)
+{
+ pattern <- paste("[^0-9A-Za-z_\\.]", extractor, sep = "",
+ "\\([^\\)]+\\)")
+ re.matches <- gregexpr(pattern, text = string, perl = TRUE)[[1]]
+ if (re.matches[1] == -1) {
+ return(list(chunks = list(list(before = string)), after = ""))
+ }
+ chunks <- list()
+ prev.end <- 0
+ for (i in 1:length(re.matches)) {
+ re.start <- re.matches[i]
+ re.end <- re.start + attr(re.matches, "match.length")[i] -
+ 1
+ locus.cipher <- substring(string, re.start + 1, re.end)
+ arg.string <- string.trim(gsub("\\)", "", gsub(".*\\(",
+ "", locus.cipher)))
+ args <- unlist(strsplit(arg.string, split = "\\s*,\\s*",
+ perl = TRUE))
+ locus.name <- args[1]
+ args <- args[-1]
+ tag = paste(sep = "-", locus.name, extractor, paste(collapse = "-",
+ args))
+ chunks[[i]] <- list(before = substring(string, prev.end +
+ 1, re.start), locus.cipher = locus.cipher, locus.name = locus.name,
+ locus.args = args, predictor.tag = tag)
+ prev.end <- re.end
+ }
+ list(chunks = chunks, tail = substring(string, prev.end +
+ 1))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.formula.encipher.locus.Rd b/man/bagpipe.formula.encipher.locus.Rd
new file mode 100644
index 0000000..4476eb7
--- /dev/null
+++ b/man/bagpipe.formula.encipher.locus.Rd
@@ -0,0 +1,62 @@
+\name{bagpipe.formula.encipher.locus}
+\alias{bagpipe.formula.encipher.locus}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.formula.encipher.locus
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.formula.encipher.locus(marker, model)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (marker, model)
+{
+ paste(bagpipe.formula.extractor.lookup(model = model), sep = "",
+ "(", marker, ")")
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.formula.error.Rd b/man/bagpipe.formula.error.Rd
new file mode 100644
index 0000000..684c01f
--- /dev/null
+++ b/man/bagpipe.formula.error.Rd
@@ -0,0 +1,58 @@
+\name{bagpipe.formula.error}
+\alias{bagpipe.formula.error}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.formula.error
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.formula.error(...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (...)
+{
+ stop("Bagpipe Formula Error: ", ..., "\n", call. = FALSE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.formula.extractor.lookup.Rd b/man/bagpipe.formula.extractor.lookup.Rd
new file mode 100644
index 0000000..cbc793e
--- /dev/null
+++ b/man/bagpipe.formula.extractor.lookup.Rd
@@ -0,0 +1,82 @@
+\name{bagpipe.formula.extractor.lookup}
+\alias{bagpipe.formula.extractor.lookup}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.formula.extractor.lookup
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.formula.extractor.lookup(extractor = NULL, model = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{extractor}{
+%% ~~Describe \code{extractor} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (extractor = NULL, model = NULL)
+{
+ extractor.info <- list(interval.additive = list(tag = "additive",
+ happy.model = "additive"), interval.full = list(tag = "full",
+ happy.model = "full"), interval.dominance = list(tag = "dominance",
+ happy.model = "dominance"), interval.prob.hom = list(tag = "prob.hom",
+ happy.model = NA), genotype = list(tag = "genotype",
+ happy.model = "genotype"), genotype.additive = list(tag = "genotype.additive",
+ happy.model = "genotype.additive"), genotype.hier = list(tag = "genotype.hier",
+ happy.model = "genotype.hier"), interval.fullasym = list(tag = "fullasym",
+ happy.model = "fullasym"))
+ if (!is.null(extractor)) {
+ return(extractor.info[[extractor, exact = TRUE]])
+ }
+ extractor.table = data.frame(extractor = names(extractor.info),
+ tag = sapply(extractor.info, function(x) {
+ x$tag
+ }), happy.model = sapply(extractor.info, function(x) {
+ x$happy.model
+ }), stringsAsFactors = FALSE)
+ if (!is.null(model)) {
+ return(extractor.table$extractor[match(model, extractor.table$happy.model)])
+ }
+ extractor.table
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.formula.has.abstract.loci.Rd b/man/bagpipe.formula.has.abstract.loci.Rd
new file mode 100644
index 0000000..3cc0bc7
--- /dev/null
+++ b/man/bagpipe.formula.has.abstract.loci.Rd
@@ -0,0 +1,58 @@
+\name{bagpipe.formula.has.abstract.loci}
+\alias{bagpipe.formula.has.abstract.loci}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.formula.has.abstract.loci
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.formula.has.abstract.loci(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ "THE.LOCUS" \%in\% split.formula(x)$predictor.vars
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.formula.reserved.variables.Rd b/man/bagpipe.formula.reserved.variables.Rd
new file mode 100644
index 0000000..4f52a2d
--- /dev/null
+++ b/man/bagpipe.formula.reserved.variables.Rd
@@ -0,0 +1,58 @@
+\name{bagpipe.formula.reserved.variables}
+\alias{bagpipe.formula.reserved.variables}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.formula.reserved.variables
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.formula.reserved.variables(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ c("THE.LOCUS", happy.get.strains(h))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.get.design.Rd b/man/bagpipe.get.design.Rd
new file mode 100644
index 0000000..9f1b712
--- /dev/null
+++ b/man/bagpipe.get.design.Rd
@@ -0,0 +1,115 @@
+\name{bagpipe.get.design}
+\alias{bagpipe.get.design}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.get.design
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.get.design(h, locus, extractor, extractor.args, extractor.tag, subjects)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{locus}{
+%% ~~Describe \code{locus} here~~
+}
+ \item{extractor}{
+%% ~~Describe \code{extractor} here~~
+}
+ \item{extractor.args}{
+%% ~~Describe \code{extractor.args} here~~
+}
+ \item{extractor.tag}{
+%% ~~Describe \code{extractor.tag} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, locus, extractor, extractor.args, extractor.tag,
+ subjects)
+{
+ num.founders = length(happy.get.strains(h))
+ data = NULL
+ happy.model = bagpipe.formula.extractor.lookup(extractor)$happy.model
+ if (!is.na(happy.model)) {
+ data = happy.get.design(h, marker = locus, subjects = subjects,
+ model = happy.model, as.data.frame = FALSE)
+ if (1 == ncol(data)) {
+ colnames(data) <- make.names(paste(locus.name, ".",
+ extractor.tag, sep = ""))
+ }
+ else {
+ colnames(data) <- make.names(paste(locus.name, ".",
+ extractor.tag, ".", colnames(data), sep = ""))
+ }
+ }
+ else if ("interval.prob.hom" == extractor) {
+ hd = happy.get.design(h, marker = locus, subjects = subjects,
+ model = "full", as.data.frame = FALSE)
+ if (0 == length(extractor.args)) {
+ data = as.matrix(rowSums(hd[, 1:num.founders]))
+ colnames(data) = paste(locus, sep = ".", extractor.tag)
+ }
+ else if (1 == length(extractor.args)) {
+ founder = extractor.args
+ k = match(founder, happy.get.strains(h))
+ if (is.na(k)) {
+ bagpipe.formula.error("non-existant founder '",
+ founder, "' specified for ", extractor)
+ }
+ data = as.matrix(hd[, k])
+ colnames(data) = paste(locus, sep = ".", extractor.tag,
+ founder)
+ }
+ else {
+ bagpipe.formula.error(extractor, " takes 1 or 2 arguments")
+ }
+ }
+ else {
+ bagpipe.formula.error(extractor, "not implemented yet",
+ "\n")
+ }
+ data
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.init.posboot.file.Rd b/man/bagpipe.init.posboot.file.Rd
new file mode 100644
index 0000000..68f1665
--- /dev/null
+++ b/man/bagpipe.init.posboot.file.Rd
@@ -0,0 +1,78 @@
+\name{bagpipe.init.posboot.file}
+\alias{bagpipe.init.posboot.file}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.init.posboot.file
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.init.posboot.file(file, loci)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{file}{
+%% ~~Describe \code{file} here~~
+}
+ \item{loci}{
+%% ~~Describe \code{loci} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (file, loci)
+{
+ boot.cols = c(paste(loci, ".LOD", sep = ""), paste(loci,
+ ".modelcmp", sep = ""))
+ if (file.exists(file)) {
+ results <- read.delim(file)
+ format.error <- function() {
+ bagpipe.input.error("Cannot add bootstraps to incompatible boot file ",
+ file, "; must delete or rename")
+ }
+ if (length(boot.cols) != ncol(results)) {
+ format.error()
+ }
+ if (!all(boot.cols == colnames(results))) {
+ format.error()
+ }
+ return(results)
+ }
+ as.data.frame(matrix(nrow = 0, ncol = length(boot.cols),
+ dimnames = list(c(), boot.cols)))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.input.error.Rd b/man/bagpipe.input.error.Rd
new file mode 100644
index 0000000..fd505b0
--- /dev/null
+++ b/man/bagpipe.input.error.Rd
@@ -0,0 +1,58 @@
+\name{bagpipe.input.error}
+\alias{bagpipe.input.error}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.input.error
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.input.error(...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (...)
+{
+ stop("Bagpipe Input Error: ", ..., "\n", call. = FALSE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.parse.sdp.string.Rd b/man/bagpipe.parse.sdp.string.Rd
new file mode 100644
index 0000000..b427e2c
--- /dev/null
+++ b/man/bagpipe.parse.sdp.string.Rd
@@ -0,0 +1,72 @@
+\name{bagpipe.parse.sdp.string}
+\alias{bagpipe.parse.sdp.string}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.parse.sdp.string
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.parse.sdp.string(h, sdp.string)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{sdp.string}{
+%% ~~Describe \code{sdp.string} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, sdp.string)
+{
+ SPLIT.TOKEN = "."
+ num.founders = happy.num.strains(h)
+ token = ifow(igrep(pattern = SPLIT.TOKEN, sdp.string, fixed = TRUE),
+ SPLIT.TOKEN, "")
+ sdp.symbols = unlist(strsplit(sdp.string, split = token,
+ fixed = TRUE))
+ if (length(sdp.symbols) != num.founders) {
+ bagpipe.formula.error("SDP must specify grouping for ",
+ num.founders, " founders, but '", sdp.string, "' implies only ",
+ length(sdp.symbols), " founders")
+ }
+ sdp.symbols
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.posboot.scan.Rd b/man/bagpipe.posboot.scan.Rd
new file mode 100644
index 0000000..2f6ba67
--- /dev/null
+++ b/man/bagpipe.posboot.scan.Rd
@@ -0,0 +1,90 @@
+\name{bagpipe.posboot.scan}
+\alias{bagpipe.posboot.scan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.posboot.scan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.posboot.scan(h, loci, num.boots, results.file, save.every = 10)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{loci}{
+%% ~~Describe \code{loci} here~~
+}
+ \item{num.boots}{
+%% ~~Describe \code{num.boots} here~~
+}
+ \item{results.file}{
+%% ~~Describe \code{results.file} here~~
+}
+ \item{save.every}{
+%% ~~Describe \code{save.every} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, loci, num.boots, results.file, save.every = 10)
+{
+ boot.results = bagpipe.init.posboot.file(results.file, loci)
+ d = get.phenotype.data(h, config = config, subjects = happy.get.subjects(h))
+ pdata = d$pdata
+ first.boot = nrow(boot.results) + 1
+ if (first.boot > num.boots) {
+ return(boot.results)
+ }
+ cat("Bootstraps ", first.boot, " to ", num.boots, ":", sep = "")
+ for (b in first.boot:num.boots) {
+ boot.set = sample(1:nrow(pdata), replace = TRUE)
+ d$pdata = pdata[boot.set, ]
+ scan.result = scan.phenotype(h, config, markers = loci,
+ scan.type = "scan", verbose = FALSE, data.object = d)
+ boot.results[b, ] = c(scan.result$table$LOD, scan.result$table$modelcmp)
+ if (b - first.boot\%\%save.every != 0 | b == num.boots) {
+ write.delim(boot.results, file = results.file)
+ }
+ cat("[", sep = "", b, "]")
+ }
+ cat("\n")
+ boot.results
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/bagpipe.read.configfile.Rd b/man/bagpipe.read.configfile.Rd
new file mode 100644
index 0000000..a3cdf0c
--- /dev/null
+++ b/man/bagpipe.read.configfile.Rd
@@ -0,0 +1,65 @@
+\name{bagpipe.read.configfile}
+\alias{bagpipe.read.configfile}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{bagpipe.read.configfile
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+bagpipe.read.configfile(config.file)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config.file}{
+%% ~~Describe \code{config.file} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config.file)
+{
+ config <- read.configfile(config.file)
+ for (filespec in c("genome.cache.dir", "phenotype.file")) {
+ if (!configfile.has(config, filespec))
+ next
+ pathname <- configfile.string(config, filespec)
+ config[[filespec]] <- interpolate.Sys.env(pathname)
+ }
+ config
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/caught.error.Rd b/man/caught.error.Rd
new file mode 100644
index 0000000..5b3898d
--- /dev/null
+++ b/man/caught.error.Rd
@@ -0,0 +1,57 @@
+\name{caught.error}
+\alias{caught.error}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{``Catch'' function testing whether a try-error occurred
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+caught.error(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ inherits(x, "try-error")
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.flag.Rd b/man/cmdline.flag.Rd
new file mode 100644
index 0000000..198c350
--- /dev/null
+++ b/man/cmdline.flag.Rd
@@ -0,0 +1,40 @@
+\name{cmdline.flag}
+\alias{cmdline.flag}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Parse command line flags
+}
+\description{
+Returns TRUE if the specified flag was given on the command line.
+}
+\usage{
+cmdline.flag(name)
+}
+\arguments{
+ \item{name}{A character scalar specifying the name of the flag.
+}
+}
+\details{
+This function checks whether the specified flag was issued, looking this up in the arguments returned by the standard function \code{commandArgs(trailingOnly=TRUE)}. For example, if \code{arg="verbose"}, the cmdline.flag will return TRUE if \code{--verbose} was included on the R or Rscript command line at some point after \code{--arg}, and FALSE otherwise.
+}
+\value{
+ A logical scalar that is TRUE only if a flag corresponding to \code{arg=} was given on the command line.
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+\code{cmdline.option}
+}
+\examples{
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.has.option.Rd b/man/cmdline.has.option.Rd
new file mode 100644
index 0000000..6157f6f
--- /dev/null
+++ b/man/cmdline.has.option.Rd
@@ -0,0 +1,40 @@
+\name{cmdline.has.option}
+\alias{cmdline.has.option}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Check for command line arguments
+}
+\description{
+ Returns TRUE if a key=value argument with the specified key was issued on the command line (after \code{--args}).
+}
+\usage{
+cmdline.has.option(key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+}
+\details{
+ This command is currently implemented as a call to \code{cmdline.option} with \code{allow.omit=TRUE}, followed by a test for equality.
+}
+\value{
+ A logical scalar that is TRUE if the specified (key=value style) argument was given on the command line and FALSE otherwise.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\seealso{
+ \code{cmdline.option}
+}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.integer.Rd b/man/cmdline.integer.Rd
new file mode 100644
index 0000000..8c5a145
--- /dev/null
+++ b/man/cmdline.integer.Rd
@@ -0,0 +1,42 @@
+\name{cmdline.integer}
+\alias{cmdline.integer}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get an integer from the command line
+}
+\description{
+A wrapper function for \code{cmdline.option} that also converts the retrieved value to type \code{integer}.
+}
+\usage{
+cmdline.integer(key, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{\dots}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+}
+\value{
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\section{Warning}{
+ The function will throw an error if the command line value of the requested argument cannot be converted to type \code{integer}.
+}
+\seealso{
+ \code{cmdline.strings}, \code{cmdline.integer}
+}
+\examples{
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.integers.Rd b/man/cmdline.integers.Rd
new file mode 100644
index 0000000..8a9ee79
--- /dev/null
+++ b/man/cmdline.integers.Rd
@@ -0,0 +1,43 @@
+\name{cmdline.integers}
+\alias{cmdline.integers}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a list of integers from the command line
+}
+\description{
+ A wrapper for \code{cmdline.strings} that converts its return value to type \code{integer}.
+}
+\usage{
+cmdline.integers(key,...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{\dots}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+}
+\value{
+ A vector of type \code{integer}.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+ The function can handle a list of one integer.
+
+ The function will throw an error if any of the listed items cannot be converted to integers by \code{as.integer}.
+}
+\seealso{
+ \code{cmdline.options}
+}
+\examples{
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.logical.Rd b/man/cmdline.logical.Rd
new file mode 100644
index 0000000..5552525
--- /dev/null
+++ b/man/cmdline.logical.Rd
@@ -0,0 +1,41 @@
+\name{cmdline.logical}
+\alias{cmdline.logical}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a logical value from the command line
+}
+\description{
+ A wrapper function for \code{cmdline.option} that also converts the retrieved value to type \code{logical}.
+}
+\usage{
+cmdline.logical(key,...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{\dots}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+ Logical values are interpreted from the command line as follows: "0", "F" and "FALSE" are \code{FALSE}, whereas "T", "TRUE", and any non-zero number is \code{TRUE}. "NA" is coerced to \code{NA} and all other strings will throw an error.
+}
+\value{
+ A scalar of type \code{logical}.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\seealso{
+ \code{cmdline.option},\code{cmdline.logicals}
+}
+\examples{
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.logicals.Rd b/man/cmdline.logicals.Rd
new file mode 100644
index 0000000..c51c6bd
--- /dev/null
+++ b/man/cmdline.logicals.Rd
@@ -0,0 +1,42 @@
+\name{cmdline.logicals}
+\alias{cmdline.logicals}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a list of logical values from the command line
+}
+\description{
+ A wrapper for \code{cmdline.strings} that converts its return value to type \code{logical}
+}
+\usage{
+cmdline.logicals(key,...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{\dots}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+ See \code{cmdline.logical} for what counts as \code{TRUE} and \code{FALSE}. See \code{cmdline.strings} for restricting the number of values. See \code{cmdline.option} for examples.
+}
+\value{
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\seealso{
+\code{cmdline.option},\code{cmdline.logical},\code{cmdline.strings}
+}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.numeric.Rd b/man/cmdline.numeric.Rd
new file mode 100644
index 0000000..158a031
--- /dev/null
+++ b/man/cmdline.numeric.Rd
@@ -0,0 +1,41 @@
+\name{cmdline.numeric}
+\alias{cmdline.numeric}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a numeric from the command line
+}
+\description{
+ A wrapper function for \code{cmdline.option} that also converts the retrieved value to type \code{numeric}.
+}
+\usage{
+cmdline.numeric(key,...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{\dots}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+}
+\value{
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\seealso{
+ \code{cmdline.option}, \code{cmdline.numerics}
+}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.numerics.Rd b/man/cmdline.numerics.Rd
new file mode 100644
index 0000000..80779ad
--- /dev/null
+++ b/man/cmdline.numerics.Rd
@@ -0,0 +1,40 @@
+\name{cmdline.numerics}
+\alias{cmdline.numerics}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a list of numerics from the command line
+}
+\description{
+ A wrapper for \code{cmdline.strings} that converts its return value to type \code{numeric}
+}
+\usage{
+cmdline.numerics(key, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{\dots}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+}
+\value{
+ A vector of type \code{numeric}.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\seealso{
+\code{cmdline.option}, \code{cmdline.numeric}, \code{cmdline.strings}
+}
+\examples{
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.option.Rd b/man/cmdline.option.Rd
new file mode 100644
index 0000000..9f3425d
--- /dev/null
+++ b/man/cmdline.option.Rd
@@ -0,0 +1,78 @@
+\name{cmdline.option}
+\alias{cmdline.option}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get the value of a named argument from the command line
+}
+\description{
+Returns the value part of a --key=value format command line option, given the key.
+}
+\usage{
+cmdline.option(key, default = NULL, stop.on.fail = TRUE, allow.omit = !stop.on.fail, allowed.values = NULL)
+}
+\arguments{
+ \item{key}{
+ A scalar character string specifying the key of the named argument.
+}
+ \item{default}{
+ A value to be returned if the key specified in \code{option=} was never given on the command line. If \code{default=NULL} and \code{stop.on.fail=TRUE}, then the function throws an error.
+}
+ \item{stop.on.fail}{
+ If the key specified in \code{option=} was never given on the command line, if \code{default=NULL} and \code{stop.on.fail=TRUE}, then the function throws an error. Otherwise, the function returns the value specified by \code{default=}.
+}
+ \item{allow.omit}{
+ An alternative way of saying stop.on.fail=FALSE.
+}
+ \item{allowed.values}{
+ A vector giving acceptable values for the option. If \code{allowed.values} is non-null then then the function throws an error if it encounters any values that are not among this acceptable set. By default, \code{allowed.values=NULL} and any values are acceptable.
+}
+}
+\details{
+\code{cmdline.option} is the core function on which most others in the \code{cmdline} package are based. It parses command line arguments from the standard R function \code{commandArgs(trailingOnly=TRUE)} (package: \code{base}), extracts those of the form \code{--key=value} (NOTE: there should be NO WHITE SPACE in the specification of a key-value pair), and returns the corresponding \code{value} for a \code{key}. The \code{value} may contain commas or other non-white-space characters. If [...]
+}
+\value{
+ The value of the argument as a character string.
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+ \code{cmdline.flag} for parsing arguments with no value, \code{cmdline.has.option} for checking for the existence of key=value arguments, \code{cmdline.strings} for handling of multiple values for a single argument, and \code{cmdline.integer}, \code{cmdline.numeric} and \code{cmdline.logical} for convenience functions that recast the return value to a different type.
+ \code{commandArgs} with option \code{trailingOnly=TRUE} in the \code{base} package for information on what is considered a command line argument.
+}
+\examples{
+# FIRST: if R or Rscript is called with command line:
+# R --args --infiles=chr1.txt,chr2.txt,chr3.txt --outfile=plot.pdf --height=3.4 --mfrow=2,2 --verbose --pagesize=11.5,8.2 --want.plot=1 --at.least.three.args=1,2,3,4,5 --pages=10 --booleans=0,1,2,TRUE,T,FALSE,F
+# then in interactive R or in the Rscript do
+library(cmdline)
+
+cmdline.has.option("outfile")
+cmdline.option("outfile")
+cmdline.string("outfile")
+
+cmdline.flag("verbose")
+
+cmdline.string("infiles")
+cmdline.numeric("height")
+cmdline.logical("want.plot")
+
+# split multiple values
+cmdline.strings("infiles")
+cmdline.integers("mfrow")
+cmdline.numerics("pagesize", howmany=2)
+cmdline.strings("booleans")
+cmdline.logicals("booleans")
+
+cmdline.integers("at.least.three.args", howmany=c(3,Inf))
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.string.Rd b/man/cmdline.string.Rd
new file mode 100644
index 0000000..c4c4bb2
--- /dev/null
+++ b/man/cmdline.string.Rd
@@ -0,0 +1,39 @@
+\name{cmdline.string}
+\alias{cmdline.string}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a string from the command line.
+}
+\description{
+ An alias for \code{cmdline.option}. Useful in the code to emphasize that it is a string being returned.
+}
+\usage{
+ cmdline.string(key,...)
+}
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{...}{
+ Arguments to \code{cmdline.option}.
+}
+}
+\details{
+}
+\value{
+ A scalar character string.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+}
+\seealso{
+ \code{cmdline.option}, \code{cmdline.strings}
+}
+\examples{
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cmdline.strings.Rd b/man/cmdline.strings.Rd
new file mode 100644
index 0000000..303f488
--- /dev/null
+++ b/man/cmdline.strings.Rd
@@ -0,0 +1,49 @@
+\name{cmdline.strings}
+\alias{cmdline.strings}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Get a multiple values specified for a single command line argument
+}
+\description{
+ Returns a vector of strings corresponding to a multivalued command line argument, provided the individual values are separated only by commas. For example, if the command line includes the argument \code{--files=fred.txt,wilma.txt,betty.doc}, calling \code{cmdline.strings("files")} within R will return the vector \code{c("fred.txt", "wilma.txt" and "betty.doc")}.
+}
+\usage{
+cmdline.strings(key, howmany=c(0,Inf), ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{key}{
+ The name of the command line argument.
+}
+ \item{howmany}{
+ The allowed number of values expressed as a range (ie, a numeric vector of length 2), or as a single number. By default \code{howmany=c(0,Inf)}, corresponding to no restrictions.
+}
+ \item{\dots}{
+ Other arguments to \code{cmdline.option}.
+}
+}
+\details{
+ This function assumes the argument \code{option=} has been specified on the command line to have one or more values. For example, if the argument key was \code{option="files"} and the corresponding values specified by the user were "fred.txt", "wilma.txt" and "betty.doc", then it is assumed this was written on the command line in a single string (ie, unbroken by whitespace) as \code{--files=fred.txt,wilma.txt,betty.doc} at some point after R's recommended \code{--args} flag.
+
+ For a given key=value pair, the function works by calling \code{cmdline.option} to get \code{value} as a string (eg, "fred.txt,wilma.txt,betty.doc"), splitting the string by commas, checking the number of values, and returning the result.
+}
+\value{
+ A vector of type \code{character}.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+ The function can handle lists containing only one item. These are returned as if \code{cmdline.string} was called.
+}
+\seealso{
+ \code{cmdline.option}, plus various convenience functions converting the return value to non-character types: \code{cmdline.integers}, \code{cmdline.numerics}, \code{cmdline.logicals}.
+}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/cols.as.Rd b/man/cols.as.Rd
new file mode 100644
index 0000000..e3f4847
--- /dev/null
+++ b/man/cols.as.Rd
@@ -0,0 +1,104 @@
+\name{cols.as}
+\alias{cols.as}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{cols.as
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+cols.as(df, convert = list(), pattern = NULL, Class = NULL, character = NULL, integer = NULL, numeric = NULL, factor = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{df}{
+%% ~~Describe \code{df} here~~
+}
+ \item{convert}{
+%% ~~Describe \code{convert} here~~
+}
+ \item{pattern}{
+%% ~~Describe \code{pattern} here~~
+}
+ \item{Class}{
+%% ~~Describe \code{Class} here~~
+}
+ \item{character}{
+%% ~~Describe \code{character} here~~
+}
+ \item{integer}{
+%% ~~Describe \code{integer} here~~
+}
+ \item{numeric}{
+%% ~~Describe \code{numeric} here~~
+}
+ \item{factor}{
+%% ~~Describe \code{factor} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (df, convert = list(), pattern = NULL, Class = NULL,
+ character = NULL, integer = NULL, numeric = NULL, factor = NULL)
+{
+ require(methods)
+ if (!is.null(pattern) & !is.null(Class)) {
+ matching.cols <- grep(pattern, value = TRUE, colnames(df))
+ conv <- list()
+ conv[matching.cols] <- Class
+ convert <- c(convert, conv)
+ }
+ if (!is.null(character))
+ convert[character] <- "character"
+ if (!is.null(integer))
+ convert[integer] <- "integer"
+ if (!is.null(numeric))
+ convert[numeric] <- "numeric"
+ if (!is.null(factor))
+ convert[factor] <- "factor"
+ for (name in names(convert)) {
+ if (1 == length(convert[[name]])) {
+ func <- paste("as.", convert[[name]], sep = "")
+ df[, name] <- as(df[, name], convert[[name]])
+ }
+ else {
+ df[, name] <- factor(as.character(df[, name]), levels = convert[[name]])
+ }
+ }
+ df
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.get.Rd b/man/configfile.get.Rd
new file mode 100644
index 0000000..4c23d63
--- /dev/null
+++ b/man/configfile.get.Rd
@@ -0,0 +1,72 @@
+\name{configfile.get}
+\alias{configfile.get}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get setting for a given set of parameters
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.get(config, keys, default = NULL, stop.on.fail = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{keys}{
+%% ~~Describe \code{keys} here~~
+}
+ \item{default}{
+%% ~~Describe \code{default} here~~
+}
+ \item{stop.on.fail}{
+%% ~~Describe \code{stop.on.fail} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, keys, default = NULL, stop.on.fail = TRUE)
+{
+ if (!mdlist.has(config, keys)) {
+ if (!stop.on.fail | (missing(stop.on.fail) & !missing(default))) {
+ return(default)
+ }
+ stop("Cannot find parameters ", keys, " in configfile\n")
+ }
+ return(mdlist.get(config, keys))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.has.Rd b/man/configfile.has.Rd
new file mode 100644
index 0000000..fe1ff22
--- /dev/null
+++ b/man/configfile.has.Rd
@@ -0,0 +1,60 @@
+\name{configfile.has}
+\alias{configfile.has}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Test whether a given parameter was set
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.has(config, keys)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{keys}{
+%% ~~Describe \code{keys} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, keys)
+{
+ mdlist.has(config, keys)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.integer.Rd b/man/configfile.integer.Rd
new file mode 100644
index 0000000..475efe2
--- /dev/null
+++ b/man/configfile.integer.Rd
@@ -0,0 +1,63 @@
+\name{configfile.integer}
+\alias{configfile.integer}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get integer field
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.integer(config, keys, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{keys}{
+%% ~~Describe \code{keys} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, keys, ...)
+{
+ as.integer(configfile.get(config, keys, ...))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.integers.Rd b/man/configfile.integers.Rd
new file mode 100644
index 0000000..d249f42
--- /dev/null
+++ b/man/configfile.integers.Rd
@@ -0,0 +1,63 @@
+\name{configfile.integers}
+\alias{configfile.integers}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get an array of integers
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.integers(config, key, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, key, ...)
+{
+ as.integer(configfile.strings(config, key, ...))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.logical.Rd b/man/configfile.logical.Rd
new file mode 100644
index 0000000..f58d66a
--- /dev/null
+++ b/man/configfile.logical.Rd
@@ -0,0 +1,63 @@
+\name{configfile.logical}
+\alias{configfile.logical}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get array of logicals
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.logical(config, keys, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{keys}{
+%% ~~Describe \code{keys} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, keys, ...)
+{
+ as.logical(configfile.get(config, keys, ...))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.numeric.Rd b/man/configfile.numeric.Rd
new file mode 100644
index 0000000..79dfa1f
--- /dev/null
+++ b/man/configfile.numeric.Rd
@@ -0,0 +1,63 @@
+\name{configfile.numeric}
+\alias{configfile.numeric}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get numeric field
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.numeric(config, keys, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{keys}{
+%% ~~Describe \code{keys} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, keys, ...)
+{
+ as.numeric(configfile.get(config, keys, ...))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.numerics.Rd b/man/configfile.numerics.Rd
new file mode 100644
index 0000000..2d88f50
--- /dev/null
+++ b/man/configfile.numerics.Rd
@@ -0,0 +1,63 @@
+\name{configfile.numerics}
+\alias{configfile.numerics}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get array of numerics
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.numerics(config, key, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, key, ...)
+{
+ as.numeric(configfile.strings(config, key, ...))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.string.Rd b/man/configfile.string.Rd
new file mode 100644
index 0000000..c0c7bf4
--- /dev/null
+++ b/man/configfile.string.Rd
@@ -0,0 +1,72 @@
+\name{configfile.string}
+\alias{configfile.string}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get character string field
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.string(config, keys, default = NULL, stop.on.fail = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{keys}{
+%% ~~Describe \code{keys} here~~
+}
+ \item{default}{
+%% ~~Describe \code{default} here~~
+}
+ \item{stop.on.fail}{
+%% ~~Describe \code{stop.on.fail} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, keys, default = NULL, stop.on.fail = TRUE)
+{
+ if (!mdlist.has(config, keys)) {
+ if (!stop.on.fail | (missing(stop.on.fail) & !missing(default))) {
+ return(default)
+ }
+ stop("Cannot find parameters ", keys, " in configfile\n")
+ }
+ return(mdlist.get(config, keys))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/configfile.strings.Rd b/man/configfile.strings.Rd
new file mode 100644
index 0000000..61345d4
--- /dev/null
+++ b/man/configfile.strings.Rd
@@ -0,0 +1,72 @@
+\name{configfile.strings}
+\alias{configfile.strings}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Get array of character strings
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+configfile.strings(config, key, delim = "[\\s,]+", ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+ \item{delim}{
+%% ~~Describe \code{delim} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, key, delim = "[\\s,]+", ...)
+{
+ if (1 != length(key)) {
+ stop("Must pass only one key at a time to method\n")
+ }
+ string <- configfile.get(config, key, ...)
+ if (is.null(string))
+ return(NULL)
+ unlist(strsplit(string, split = delim, perl = TRUE))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/dfapply.Rd b/man/dfapply.Rd
new file mode 100644
index 0000000..b9294e2
--- /dev/null
+++ b/man/dfapply.Rd
@@ -0,0 +1,71 @@
+\name{dfapply}
+\alias{dfapply}
+\title{dfapply -- apply a function over subsets of a data frame}
+\description{
+ Apply a function over all subsets of a data frame, where each subset is specified by a unique combination of the levels of certain factors. This is an alternative to the functions \code{tapply} and \code{by} in package:base.
+}
+\usage{
+dfapply(data, INDICES, FUN,
+ results = list(), results.add.FUN = c,
+ matched.vector = FALSE,
+ pass.key.to.FUN = is.list(INDICES),
+ ...)
+}
+\arguments{
+ \item{data}{
+ A \code{data.frame} object.
+}
+ \item{INDICES}{
+ a factor or a list of factors, each of length \code{nrow(data)}.
+}
+ \item{FUN}{
+ a function to be applied to each data frame subset of \code{data}. This function should expect its first argument to be the data frame subset. If \code{INDICES} is a factor, then any remaining arguments in \code{...} are passed along to the function. However, if \code{INDICES} is a list or data frame then \code{FUN} should *also* expect a second argument: a data frame comprising a single row that contains only the values of \code{INDICES} specifying the subset. Often, a user-specifie [...]
+}
+ \item{results}{
+ an object that will hold the results of applying \code{FUN} to each data frame subset. This object is then returned to the client when the function completes. \code{results} is typically specified in conjunction with \code{results.add.FUN} (see below). If \code{matched.vector=TRUE} then this argument (and its partner \code{results.add.FUN}) is ignored. See details.
+}
+ \item{results.add.FUN}{
+ a function to add each result of \code{FUN} to \code{results}. This function is used to update the \code{results} object with each time \code{FUN} is applied to a new data subset. It should expect its first argument to be the \code{results} object, and its second argument to be the output of \code{FUN}. Its return value should be an updated \code{results} object. If \code{matched.vector=TRUE} then this is ignored. See details.
+}
+ \item{matched.vector}{
+ optionally return a vector of length \code{nrow(data)} whose ith element corresponds to the ith row of \code{data} for all i. For this to work, \code{matched.vector==TRUE} assumes that \code{FUN(x)} always returns a vector of length \code{nrow(x)}.
+}
+ \item{\dots}{
+ additional (3rd, 4th, etc) arguments passed to \code{FUN}.
+}
+}
+\details{
+ Let sdata be a subset of \code{data} that corresponds to a unique combination of levels of the factors listed in \code{INDICES}, s>0 be the number of rows of sdata, S be the number of subsets, and \code{udata <- sdata[,names(INDICES)]} (assuming \code{INDICES} is named to match colnames of \code{data}). Under default settings, this function applies an arbitrary function \code{FUN(sdata,udata,...)} to each sdata, storing the output in a S-length list \code{results}. Respecifying \code{r [...]
+
+ Sometimes \code{FUN} will be set to always return a vector of length \code{nrow(sdata)}, such that the function is being used to assign a single number for each \code{data} row (eg, a score for each row that is subset-aware). In such cases, note that the indices of the returned vector would not necessarily match those of \code{data}. Rather, \code{results} would be built up subset by subset, such that the first s elements would be, for example, the elements that matched subset S=1. In [...]
+}
+\value{
+ An object containing the results of applying \code{FUN} over subsets of \code{data}. If \code{matched.vector=FALSE}, then the object will be of the same type as \code{results}, and the order of the elements (or rows) will not necessarily correspond to the row order in \code{data}. If \code{matched.vector=TRUE}, the return value will be a vector of length \code{nrow(data)} whose elements correspond exactly to those in \code{data}.
+}
+\references{
+}
+\author{
+William Valdar
+}
+\note{
+}
+\seealso{
+}
+\examples{
+d <- data.frame(
+ batch=rep(1:3,length.out=100),
+ day=rep(1:2, length.out=100),
+ weight=rnorm(100)^2)
+
+dfapply(d, d$batch, nrow)
+
+d$DayBatchMeanWeight <- dfapply(d, d[,c("batch","day")],
+ function(x,...){mean(x$weight)},
+ matched.vector=TRUE)
+
+DayMeans <- dfapply(d, list(day=d$day),
+ function(x,u){u$weight <- mean(x$weight); u },
+ results = NULL, results.add.FUN = rbind )
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/do.scan.Rd b/man/do.scan.Rd
new file mode 100644
index 0000000..49cff46
--- /dev/null
+++ b/man/do.scan.Rd
@@ -0,0 +1,107 @@
+\name{do.scan}
+\alias{do.scan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{do.scan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+do.scan(h, config, loci, output.dir = "./", output.file, phenotype, scan.type, verbose = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{loci}{
+%% ~~Describe \code{loci} here~~
+}
+ \item{output.dir}{
+%% ~~Describe \code{output.dir} here~~
+}
+ \item{output.file}{
+%% ~~Describe \code{output.file} here~~
+}
+ \item{phenotype}{
+%% ~~Describe \code{phenotype} here~~
+}
+ \item{scan.type}{
+%% ~~Describe \code{scan.type} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, config, loci, output.dir = "./", output.file, phenotype,
+ scan.type, verbose = FALSE)
+{
+ phenotype <- configfile.get(config, "analysis.id")
+ output.file <- file.path(output.dir, output.file)
+ if (!file.exists(output.dir)) {
+ stop("Directory", output.dir, "does not exist\n")
+ }
+ result <- scan.phenotype(h, config = config, markers = loci,
+ scan.type = scan.type, verbose = verbose)
+ if (is.null(result)) {
+ stop("No results for analysis id ", phenotype, "\n")
+ next
+ }
+ if ("scan" == scan.type) {
+ result$phenotype <- phenotype
+ result$date <- date()
+ result$chromosome <- paste(sep = ",", unique(happy.get.chromosome(h,
+ loci)))
+ result$build <- configfile.string(config, "build", stop.on.fail = FALSE,
+ default = "UnknownBuild")
+ result$population <- configfile.string(config, "population",
+ stop.on.fail = FALSE, default = "UnknownPopulation")
+ result$phase <- configfile.string(config, "phase", stop.on.fail = FALSE,
+ default = "UnknownPhase")
+ result$genetic.model <- "happy"
+ write.scan(result, output.file)
+ }
+ if (scan.type \%in\% c("permute.scan", "nullsim.scan", "nullsimpermute.scan")) {
+ write.multiscan.max(result, file = output.file)
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/drop.formula.vars.Rd b/man/drop.formula.vars.Rd
new file mode 100644
index 0000000..1e72acc
--- /dev/null
+++ b/man/drop.formula.vars.Rd
@@ -0,0 +1,73 @@
+\name{drop.formula.vars}
+\alias{drop.formula.vars}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{drop.formula.vars
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+drop.formula.vars(formulae, patterns)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{formulae}{
+%% ~~Describe \code{formulae} here~~
+}
+ \item{patterns}{
+%% ~~Describe \code{patterns} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (formulae, patterns)
+{
+ formulae <- formula.as.string(formulae)
+ for (patt in patterns) {
+ for (i in grep(patt, formulae)) {
+ form <- formulae[i]
+ spf <- split.formula(form)
+ terms <- unlist(strsplit(spf$predictors, "\\s*\\+\\s*"))
+ unwanted <- grep(patt, terms)
+ form <- paste(spf$response, sep = " ~ ", paste(terms[-unwanted],
+ collapse = " + "))
+ formulae[i] <- form
+ }
+ }
+ formulae
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/elem.Rd b/man/elem.Rd
new file mode 100644
index 0000000..d00d40b
--- /dev/null
+++ b/man/elem.Rd
@@ -0,0 +1,64 @@
+\name{elem}
+\alias{elem}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{elem
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+elem(x, start = 1, end = length(x))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{start}{
+%% ~~Describe \code{start} here~~
+}
+ \item{end}{
+%% ~~Describe \code{end} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, start = 1, end = length(x))
+{
+ ifow(0 == length(x), integer(0), start:end)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/find.peaks.Rd b/man/find.peaks.Rd
new file mode 100644
index 0000000..e083e9d
--- /dev/null
+++ b/man/find.peaks.Rd
@@ -0,0 +1,83 @@
+\name{find.peaks}
+\alias{find.peaks}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{find.peaks
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+find.peaks(series, span = 3, ends = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{series}{
+%% ~~Describe \code{series} here~~
+}
+ \item{span}{
+%% ~~Describe \code{span} here~~
+}
+ \item{ends}{
+%% ~~Describe \code{ends} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (series, span = 3, ends = FALSE)
+{
+ if (0 == span\%\%2) {
+ span <- span + 1
+ warning("span should be an odd number in find.peaks(): ",
+ span - 1, ".", " Forcing span = ", span, "\n")
+ }
+ z <- embed(series, span)
+ col.radius <- span\%/\%2
+ mid.col <- col.radius + 1
+ result <- max.col(z) == mid.col
+ retval <- which(result) + col.radius
+ if (ends & 3 == span) {
+ if (series[1] > series[2]) {
+ retval <- c(0, retval)
+ }
+ if (series[length(series)] > series[length(series) -
+ 1]) {
+ retval[length(retval) + 1] <- length(series)
+ }
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/find.windowed.peaks.Rd b/man/find.windowed.peaks.Rd
new file mode 100644
index 0000000..2206e90
--- /dev/null
+++ b/man/find.windowed.peaks.Rd
@@ -0,0 +1,82 @@
+\name{find.windowed.peaks}
+\alias{find.windowed.peaks}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{find.windowed.peaks
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+find.windowed.peaks(x, y, radius, above = min(y), ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{y}{
+%% ~~Describe \code{y} here~~
+}
+ \item{radius}{
+%% ~~Describe \code{radius} here~~
+}
+ \item{above}{
+%% ~~Describe \code{above} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, y, radius, above = min(y), ...)
+{
+ d <- data.frame(x = x, y = y, index = 1:length(y))
+ d$peak <- FALSE
+ d$windowed.peak <- FALSE
+ d$peak[find.peaks(y, ...)] <- TRUE
+ d$peak[d$y <= above] <- FALSE
+ d <- d[order(-d$y), ]
+ for (i in which(d$peak)) {
+ if (d$peak[i] == FALSE)
+ next
+ d$windowed.peak[i] <- TRUE
+ d$peak[abs(d$x[i] - d$x) <= radius] <- FALSE
+ }
+ sort(d$index[d$windowed.peak])
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/fit.gev.Rd b/man/fit.gev.Rd
new file mode 100644
index 0000000..2f7408e
--- /dev/null
+++ b/man/fit.gev.Rd
@@ -0,0 +1,69 @@
+\name{fit.gev}
+\alias{fit.gev}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{fit.gev
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+fit.gev(data, thresholds)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{thresholds}{
+%% ~~Describe \code{thresholds} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (data, thresholds)
+{
+ require(evd)
+ model.gev <- fgev(data)
+ gev.df <- data.frame(loc = model.gev$estimate[1], loc.se = model.gev$std.err[1],
+ scale = model.gev$estimate[2], scale.se = model.gev$std.err[2],
+ shape = model.gev$estimate[3], shape.se = model.gev$estimate[3])
+ gev.thresholds.df <- data.frame(upper.tail.prob = thresholds,
+ quantile = qgev(thresholds, loc = gev.df$loc, scale = gev.df$scale,
+ shape = gev.df$shape, lower.tail = FALSE))
+ return(list(thresholds = gev.thresholds.df, gev = gev.df))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/force.logical.Rd b/man/force.logical.Rd
new file mode 100644
index 0000000..cf33067
--- /dev/null
+++ b/man/force.logical.Rd
@@ -0,0 +1,66 @@
+\name{force.logical}
+\alias{force.logical}
+\title{Force value to be interpreted as a logical
+}
+\description{
+Pass through method that converts NULLs, NAs and emtpy vectors into a logical value.
+}
+\usage{
+force.logical(x, null = FALSE, na = FALSE, empty = FALSE, blank = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+ A vector or scalar value to be interpreted as TRUE or FALSE.
+}
+ \item{null}{
+ The logical value to be returned if x is NULL (default is FALSE)
+}
+ \item{na}{
+ The logical value to be returned for elements of x that are NA (default is FALSE).
+}
+ \item{empty}{
+ The logical value to be returned if x has zero length (default is FALSE).
+}
+ \item{blank}{
+ The logical value to be returned for elements of x that are character strings of zero length.
+}
+}
+\details{
+ Problem definition: Rs "if" statements evaluate all conditions whether or not it is necessary to do so. Eg,
+\code{
+ x <- NA
+ ...
+ if (!is.na(x) & x > 0)
+}
+The above condition will evaluate as (FALSE & NA) -> (NA) -> throw error, whereas in other languages the second component is not evaluated if the first is FALSE and no error would be thrown. The default solution to this is to use multiple nested if statments like
+\code{
+ if (!is.na(x)) \{ if (x>0) \{
+}
+However, that is expensive on nesting and brackets. A better alternative:
+\code{
+ if (!is.na(x) & force.logical(x>0))
+}
+ or more explicitly
+\code{
+ if (!is.na(x) & force.logical(x>0, na=FALSE))
+}
+ or, for this example, most concisely
+\code{ if (force.logical(x>0))
+}
+Whichever, this means the condition requires only one if statement.
+}
+\value{
+ A logical vector of length equal to that of x if length(x)>=1 or a logical scalar otherwise.
+}
+\references{
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/formula.as.string.Rd b/man/formula.as.string.Rd
new file mode 100644
index 0000000..e2ec2dd
--- /dev/null
+++ b/man/formula.as.string.Rd
@@ -0,0 +1,56 @@
+\name{formula.as.string}
+\alias{formula.as.string}
+\title{Return a string representation of a formula.
+}
+\description{
+ Safely converts a formula object into a scalar character string that corresponds to the formula as originally written. If a list of formulae is passed, an equal-length vector of formula strings is returned. If a character vector is passed, it is returned unchanged. Note that the R function \code{as.character} applied to a formula object breaks up the formula into component pieces.
+}
+\usage{
+formula.as.string(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+ An object of type \code{formula}.
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+ A character of length equal to the number of formulae in x.
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\seealso{
+ \code{split.formula}
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ if (is.character(x)) {
+ return(x)
+ }
+ if (is.formula(x)) {
+ return(paste(deparse(x), collapse = ""))
+ }
+ if (is.list(x)) {
+ strings <- NULL
+ for (i in 1:length(x)) {
+ strings <- c(strings, formula.as.string(x[[i]]))
+ }
+ return(strings)
+ }
+ stop("Cannot convert object of class ", class(form), " to string\n")
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/freeman.tukey.Rd b/man/freeman.tukey.Rd
new file mode 100644
index 0000000..a5637ff
--- /dev/null
+++ b/man/freeman.tukey.Rd
@@ -0,0 +1,58 @@
+\name{freeman.tukey}
+\alias{freeman.tukey}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{freeman.tukey
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+freeman.tukey(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ 0.5 * (sqrt(x) + sqrt(x + 1))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/general.multiscan.Rd b/man/general.multiscan.Rd
new file mode 100644
index 0000000..e5a9013
--- /dev/null
+++ b/man/general.multiscan.Rd
@@ -0,0 +1,111 @@
+\name{general.multiscan}
+\alias{general.multiscan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{general.multiscan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+general.multiscan(h, responses.list, data, markers, null.formula, test.formula, scan.function.args, reduce.dmat, model.type, model.args, verbose = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{responses.list}{
+%% ~~Describe \code{responses.list} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{test.formula}{
+%% ~~Describe \code{test.formula} here~~
+}
+ \item{scan.function.args}{
+%% ~~Describe \code{scan.function.args} here~~
+}
+ \item{reduce.dmat}{
+%% ~~Describe \code{reduce.dmat} here~~
+}
+ \item{model.type}{
+%% ~~Describe \code{model.type} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, responses.list, data, markers, null.formula, test.formula,
+ scan.function.args, reduce.dmat, model.type, model.args,
+ verbose = TRUE)
+{
+ num.loci <- length(markers)
+ num.responses <- length(responses.list)
+ scores.LOD <- matrix(nrow = num.loci, ncol = num.responses)
+ scores.modelcmp <- matrix(nrow = num.loci, ncol = num.responses)
+ response.names <- split.formula(null.formula)$response.vars
+ if (verbose)
+ cat("scanning multiple phenotypes: ")
+ for (s in 1:num.responses) {
+ sim.data <- data
+ sim.data[, response.names] <- responses.list[[s]]
+ result.list <- general.scan(h, null.formula = null.formula,
+ test.formula = test.formula, markers = markers, data = sim.data,
+ model.type = model.type, model.args = model.args,
+ verbose = verbose, reduce.dmat = reduce.dmat)
+ result <- result.list$table
+ scores.modelcmp[, s] <- result$modelcmp
+ scores.LOD[, s] <- result$LOD
+ }
+ if (verbose)
+ cat("\n")
+ list(modelcmp.type = result.list$modelcmp.type, response.number = 1:num.responses,
+ scores.modelcmp = scores.modelcmp, scores.LOD = scores.LOD)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/general.scan.Rd b/man/general.scan.Rd
new file mode 100644
index 0000000..0910af5
--- /dev/null
+++ b/man/general.scan.Rd
@@ -0,0 +1,146 @@
+\name{general.scan}
+\alias{general.scan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{general.scan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+general.scan(h, null.formula, test.formula, markers, data, model.type, model.args = list(), verbose = TRUE, boot.set = NULL, reduce.dmat = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{test.formula}{
+%% ~~Describe \code{test.formula} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{model.type}{
+%% ~~Describe \code{model.type} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+ \item{boot.set}{
+%% ~~Describe \code{boot.set} here~~
+}
+ \item{reduce.dmat}{
+%% ~~Describe \code{reduce.dmat} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, null.formula, test.formula, markers, data, model.type,
+ model.args = list(), verbose = TRUE, boot.set = NULL, reduce.dmat = NULL)
+{
+ if (0 != length(grep("THE.LOCUS", null.formula))) {
+ constant.null.model = FALSE
+ }
+ if (!is.null(boot.set)) {
+ data <- data[boot.set, ]
+ }
+ num.loci <- length(markers)
+ results <- data.frame(locus = I(markers), chr = happy.get.chromosome(h,
+ markers), cM = happy.get.location(h, markers, scale = "cM"),
+ bp = happy.get.location(h, markers, scale = "bp"), num.obs = rep(nrow(data),
+ num.loci), null.logLik = rep(NA, num.loci), null.num.params = rep(NA,
+ num.loci), test.logLik = rep(NA, num.loci), test.num.params = rep(NA,
+ num.loci), LOD = rep(NA, num.loci), modelcmp = rep(NA,
+ num.loci), comments = rep(NA, num.loci))
+ if (verbose) {
+ cat("general.scan() of", num.loci, "markers:")
+ }
+ for (i in 1:num.loci) {
+ marker <- markers[i]
+ if (verbose) {
+ cat("[", i, "]", sep = "")
+ }
+ expanded <- happy.expand.formula(h, formulae = c(null.formula,
+ test.formula), THE.LOCUS = marker, subjects = data$SUBJECT.NAME,
+ dmat.transform.FUN = reduce.dmat)
+ gdata <- cbind(data, expanded$locus.data)
+ oldwarn <- options("warn")
+ options(warn = 2)
+ fit0 <- try(unify.fit(as.formula(expanded$formulae[1]),
+ data = gdata, model.type = model.type, args = model.args))
+ options(oldwarn)
+ if (caught.error(fit0)) {
+ warning(paste("Warning: could not fit null model for ",
+ marker), "\n")
+ next
+ }
+ results$null.logLik[i] <- unify.logLik(fit0)
+ results$null.num.params[i] <- unify.num.params(fit0)
+ options(warn = 2)
+ fit1 <- try(unify.fit(as.formula(expanded$formulae[2]),
+ data = gdata, model.type = model.type, args = model.args))
+ options(oldwarn)
+ if (caught.error(fit1)) {
+ warning(paste("Warning: could not fit null model for ",
+ marker), "\n")
+ next
+ }
+ results$test.logLik[i] <- unify.logLik(fit1)
+ results$test.num.params[i] <- unify.num.params(fit1)
+ options(oldwarn)
+ results$LOD[i] <- (results$test.logLik[i] - results$null.logLik[i])/log(10)
+ an <- unify.anova.list(fit0, fit1)
+ if (!is.finite(an$logP[2]))
+ an$logP[2] <- NA
+ results$modelcmp[i] <- an$logP[2]
+ }
+ if (verbose) {
+ cat("Done\n")
+ }
+ return(list(null.formula = null.formula, test.formulae = test.formula,
+ table = results, model = model.type, anova = NA, modelcmp.type = "logP"))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/genotype.to.count.Rd b/man/genotype.to.count.Rd
new file mode 100644
index 0000000..0f6b2a0
--- /dev/null
+++ b/man/genotype.to.count.Rd
@@ -0,0 +1,73 @@
+\name{genotype.to.count}
+\alias{genotype.to.count}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{genotype.to.count
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+genotype.to.count(g)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{g}{
+%% ~~Describe \code{g} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (g)
+{
+ unique.g <- unique(c(na.omit(as.character(g))))
+ if (any(2 != nchar(unique.g))) {
+ stop("Genotypes must be 2 characters long or NA\n")
+ }
+ alleles <- unique(unlist(strsplit(unique.g, "")))
+ if (2 < length(alleles)) {
+ stop("Cannot interpret genotype as additive with than >2 alleles\n")
+ }
+ count <- rep(NA, length(g))
+ count[g == paste(alleles[1], alleles[1], sep = "")] <- 0
+ if (2 == length(alleles)) {
+ count[g == paste(alleles[2], alleles[1], sep = "")] <- 1
+ count[g == paste(alleles[1], alleles[2], sep = "")] <- 1
+ count[g == paste(alleles[2], alleles[2], sep = "")] <- 2
+ }
+ return(count)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/genotype.to.factor.Rd b/man/genotype.to.factor.Rd
new file mode 100644
index 0000000..0c394ff
--- /dev/null
+++ b/man/genotype.to.factor.Rd
@@ -0,0 +1,65 @@
+\name{genotype.to.factor}
+\alias{genotype.to.factor}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{genotype.to.factor
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+genotype.to.factor(g)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{g}{
+%% ~~Describe \code{g} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (g)
+{
+ unphased <- rep(NA, length = nrow(g))
+ ok <- complete.cases(g)
+ ordered <- g[, 1] <= g[, 2]
+ mask <- ordered & ok
+ unphased[mask] <- paste(g[mask, 1], g[mask, 2], sep = "_")
+ mask <- !ordered & ok
+ unphased[mask] <- paste(g[mask, 1], g[mask, 2], sep = "_")
+ as.factor(unphased)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/genotype.to.hier.Rd b/man/genotype.to.hier.Rd
new file mode 100644
index 0000000..9aecfad
--- /dev/null
+++ b/man/genotype.to.hier.Rd
@@ -0,0 +1,70 @@
+\name{genotype.to.hier}
+\alias{genotype.to.hier}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{genotype.to.hier
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+genotype.to.hier(g)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{g}{
+%% ~~Describe \code{g} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (g)
+{
+ g <- genotype.to.count(g)
+ lo <- g == 0
+ het <- g == 1
+ hi <- g == 2
+ x <- rep(NA, length(g))
+ x[lo] <- -1
+ x[het] <- 0
+ x[hi] <- 1
+ z <- rep(NA, length(g))
+ z[lo] <- -0.5
+ z[het] <- 1
+ z[hi] <- -0.5
+ return(data.frame(additive = x, dominance = z))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/get.phenotype.data.Rd b/man/get.phenotype.data.Rd
new file mode 100644
index 0000000..366a20f
--- /dev/null
+++ b/man/get.phenotype.data.Rd
@@ -0,0 +1,196 @@
+\name{get.phenotype.data}
+\alias{get.phenotype.data}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{get.phenotype.data
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+get.phenotype.data(h, subjects, config, warn = 1)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{warn}{
+%% ~~Describe \code{warn} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, subjects, config, warn = 1)
+{
+ phenotype <- configfile.string(config, "analysis.id")
+ phenoFile <- configfile.string(config, "phenotype.file")
+ if (!file.exists(phenoFile)) {
+ bagpipe.input.error("Could not open ", phenoFile)
+ }
+ data <- read.delim(phenoFile)
+ cat("Reading ", phenoFile, "\n")
+ data[data == ""] <- NA
+ if (is.null(data$SUBJECT.NAME)) {
+ bagpipe.input.error("Phenotype file must have column SUBJECT.NAME\n")
+ }
+ data <- data[match(subjects, data$SUBJECT.NAME), ]
+ if (configfile.has(config, "model.subset")) {
+ bagpipe.input.error("Parameter model.subset is deprecated, please use data.subset\n")
+ }
+ if (configfile.has(config, "data.subset")) {
+ s <- configfile.get(config, "data.subset")
+ i <- eval(parse(text = s, env = data))
+ i <- force.logical(i, na = FALSE)
+ if (5 > sum(i)) {
+ bagpipe.data.error("Data subset ", s, " contains only ",
+ sum(i), " data points!\n")
+ }
+ data <- data[i, ]
+ }
+ model.formulae <- list(scan.formula.null = configfile.string(config,
+ "scan.formula.null"), scan.formula.test = configfile.string(config,
+ "scan.formula.test"), nullsim.formula = configfile.string(config,
+ "nullsim.formula", default = configfile.string(config,
+ "scan.formula.null")), rma.formula = configfile.string(config,
+ "rma.formula", default = configfile.string(config, "scan.formula.null")))
+ present.formulae <- which(!is.na(unlist(model.formulae)))
+ for (i in 1:length(model.formulae)) {
+ if (is.na(model.formulae[[i]]))
+ next
+ spf <- split.formula(model.formulae[[i]])
+ if (1 != length(spf$response))
+ next
+ if (spf$response == spf$response.vars)
+ next
+ new.response.name <- paste("transformed.", sep = "",
+ make.names(spf$response))
+ model.formulae[[i]] <- paste(new.response.name, sep = " ~ ",
+ spf$predictors)
+ if (new.response.name \%in\% colnames(data))
+ next
+ data[, new.response.name] <- apply.transform(spf$response,
+ data)
+ }
+ model.functions <- list(scan.function = unify.generic.model.type(configfile.string(config,
+ "scan.function")), nullsim.function = unify.generic.model.type(configfile.string(config,
+ "nullsim.function", default = configfile.string(config,
+ "scan.function"))), rma.function = unify.generic.model.type(configfile.string(config,
+ "rma.function", default = configfile.string(config, "scan.function"))))
+ if (any("survival" \%in\% unlist(model.functions))) {
+ bagpipe.input.error("Cannot currently handle survival data\n")
+ if ("survival" == configfile.string(config, "scan.function")) {
+ y <- apply.transform(split.formula(subformula)$response,
+ data)
+ if ((nzero <- sum(y[, 1] <= 0, na.rm = TRUE)) > 0) {
+ browser()
+ stop("Time to event data must have all times > 0\n")
+ }
+ }
+ }
+ quick.configfile.function.options <- function(key) {
+ if (!configfile.has(config, key)) {
+ return(list(dmat = NULL, others = list()))
+ }
+ arg.list <- eval(parse(text = paste("list(", configfile.string(config,
+ key), ")")))
+ dmat <- NULL
+ if (list.has(arg.list, "reduce.dmat")) {
+ dmat <- make.reduce.dmat.fun(arg.list$reduce.dmat)
+ arg.list$reduce.dmat <- NULL
+ }
+ return(list(dmat = dmat, others = arg.list))
+ }
+ quick.get.dmat <- function(x) {
+ quick.configfile.function.options(x)$dmat
+ }
+ quick.get.args <- function(x) {
+ quick.configfile.function.options(x)$others
+ }
+ if (!is.null(h)) {
+ expanded <- happy.expand.formula(h, formulae = unlist(model.formulae)[present.formulae],
+ subjects = data$SUBJECT.NAME, dmat.transform.FUN = quick.get.dmat("scan.function.options"))
+ for (i in 1:length(present.formulae)) {
+ model.formulae[[present.formulae[i]]] <- expanded$formulae[i]
+ }
+ if (!is.null(expanded$locus.data)) {
+ data <- cbind(data, expanded$locus.data)
+ }
+ }
+ scan.options <- list(null.formula = model.formulae$scan.formula.null,
+ test.formula = model.formulae$scan.formula.test, fitting.family = model.functions$scan.function,
+ fitting.args = quick.get.args("scan.function.options"),
+ reduce.dmat = quick.get.dmat("scan.function.options"))
+ nullsim.options <- list(null.formula = model.formulae$nullsim.formula,
+ fitting.family = model.functions$nullsim.function, fitting.args = quick.get.args("nullsim.model.function.options"),
+ reduce.dmat = quick.get.dmat("nullsim.model.function.options"))
+ rma.options <- list(null.formula = model.formulae$rma.formula.null,
+ fitting.family = model.functions$rma.model.function,
+ fitting.args = quick.get.args("rma.function.options"),
+ reduce.dmat = quick.get.dmat("rma.function.options"))
+ all.responses <- unique(unlist(lapply(model.formulae, function(x) {
+ split.formula(unlist(x))$response.vars
+ })))
+ all.covariates <- unique(unlist(lapply(model.formulae, function(x) {
+ split.formula(unlist(x))$predictor.vars
+ })))
+ all.covariates <- setdiff(all.covariates, "THE.LOCUS")
+ all.cols <- c("SUBJECT.NAME", unique(c(all.covariates, all.responses)))
+ if (!all(all.cols \%in\% colnames(data))) {
+ bagpipe.input.error("Variables in model formulae for ",
+ phenotype, " are missing from ", phenoFile, ": ",
+ paste(setdiff(all.cols, colnames(data)), collapse = ", "),
+ "\n")
+ }
+ pdata <- data[, c("SUBJECT.NAME", all.responses, all.covariates)]
+ pdata <- pdata[complete.cases(pdata), ]
+ if (0 == nrow(pdata)) {
+ bagpipe.data.error("There are no complete cases for phenotype ",
+ phenotype)
+ }
+ retval <- list(file = phenoFile, all.data = data, pdata = pdata,
+ scan.options = scan.options, nullsim.options = nullsim.options,
+ rma.options = rma.options, phenotype = phenotype, response.names = all.responses,
+ covariates = all.covariates)
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.check.bp.Rd b/man/happy.check.bp.Rd
new file mode 100644
index 0000000..b416751
--- /dev/null
+++ b/man/happy.check.bp.Rd
@@ -0,0 +1,78 @@
+\name{happy.check.bp}
+\alias{happy.check.bp}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.check.bp
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.check.bp(h, stop.on.fail = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{stop.on.fail}{
+%% ~~Describe \code{stop.on.fail} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, stop.on.fail = TRUE)
+{
+ WARN <- stop
+ if (!stop.on.fail)
+ WARN <- warning
+ assert.happy(h)
+ ok <- TRUE
+ for (chr in happy.list.chromosomes(h)) {
+ pos <- happy.get.position(h, happy.get.markers(h, chromosome = chr))
+ if (any(order(pos) != 1:length(pos))) {
+ ok <- FALSE
+ WARN("Disorder in internal representation: ", "markers are not in cM order\n")
+ }
+ }
+ all.markers <- happy.get.markers(h)
+ if (any(is.na(happy.get.bp(h, all.markers)))) {
+ ok <- FALSE
+ WARN("Some markers with NA bp\n")
+ }
+ ok
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.clear.reserve.Rd b/man/happy.clear.reserve.Rd
new file mode 100644
index 0000000..10e137d
--- /dev/null
+++ b/man/happy.clear.reserve.Rd
@@ -0,0 +1,61 @@
+\name{happy.clear.reserve}
+\alias{happy.clear.reserve}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.clear.reserve
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.clear.reserve(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ h$DATA = NULL
+ h$DATA.MAX.MEMORY = NULL
+ h$DATA.AUTO.ADD = NULL
+ h
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.allele.freq.Rd b/man/happy.get.allele.freq.Rd
new file mode 100644
index 0000000..bc917b6
--- /dev/null
+++ b/man/happy.get.allele.freq.Rd
@@ -0,0 +1,71 @@
+\name{happy.get.allele.freq}
+\alias{happy.get.allele.freq}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.allele.freq
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.allele.freq(h, markers, subjects = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, subjects = NULL)
+{
+ freqs <- rep(NA, length(markers))
+ names(freqs) <- markers
+ for (m in markers) {
+ f <- mean(na.omit(happy.get.genotype(h, m, model = "additive",
+ subjects = subjects)))/2
+ freqs[m] <- min(f, 1 - f)
+ }
+ return(freqs)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.allowed.models.Rd b/man/happy.get.allowed.models.Rd
new file mode 100644
index 0000000..9817b08
--- /dev/null
+++ b/man/happy.get.allowed.models.Rd
@@ -0,0 +1,53 @@
+\name{happy.get.allowed.models}
+\alias{happy.get.allowed.models}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.allowed.models
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.allowed.models()
+}
+%- maybe also 'usage' for other objects documented here.
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function ()
+{
+ c("genotype", "additive", "full", "full.asymmetric")
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.bp.Rd b/man/happy.get.bp.Rd
new file mode 100644
index 0000000..d347f79
--- /dev/null
+++ b/man/happy.get.bp.Rd
@@ -0,0 +1,61 @@
+\name{happy.get.bp}
+\alias{happy.get.bp}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.bp
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.bp(ha, markers)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{ha}{
+%% ~~Describe \code{ha} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (ha, markers)
+{
+ ha$genotype$genome$bp[match(markers, ha$genotype$genome$marker)]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.chromosome.Rd b/man/happy.get.chromosome.Rd
new file mode 100644
index 0000000..9b51e24
--- /dev/null
+++ b/man/happy.get.chromosome.Rd
@@ -0,0 +1,62 @@
+\name{happy.get.chromosome}
+\alias{happy.get.chromosome}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.chromosome
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.chromosome(h, markers)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers)
+{
+ assert.happy.genome(h)
+ h$genotype$genome$chromosome[match(markers, h$genotype$genome$marker)]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.chromosome.length.Rd b/man/happy.get.chromosome.length.Rd
new file mode 100644
index 0000000..af3ae1b
--- /dev/null
+++ b/man/happy.get.chromosome.length.Rd
@@ -0,0 +1,87 @@
+\name{happy.get.chromosome.length}
+\alias{happy.get.chromosome.length}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.chromosome.length
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.chromosome.length(h, chrom, scale = "bp", subtract.offset = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chrom}{
+%% ~~Describe \code{chrom} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{subtract.offset}{
+%% ~~Describe \code{subtract.offset} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chrom, scale = "bp", subtract.offset = FALSE)
+{
+ out <- rep(NA, length(chrom))
+ for (ic in 1:length(chrom)) {
+ i <- h$genotype$genome$chr == chrom[ic]
+ rng <- NULL
+ if ("bp" == scale | "Mb" == scale) {
+ rng <- range(h$genotype$genome$bp[i])
+ if ("Mb" == scale)
+ rng <- rng/1e+06
+ }
+ else if ("cM" == scale) {
+ rng <- range(h$genotype$genome$map[i])
+ }
+ else {
+ stop("Unknown scale type ", scale, "\n")
+ }
+ if (subtract.offset) {
+ return(rng[2] - rng[1])
+ }
+ out[ic] <- rng[2]
+ }
+ out
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.design.Rd b/man/happy.get.design.Rd
new file mode 100644
index 0000000..2d57542
--- /dev/null
+++ b/man/happy.get.design.Rd
@@ -0,0 +1,134 @@
+\name{happy.get.design}
+\alias{happy.get.design}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.design
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.design(h, marker, model = "additive", subjects = NULL, as.data.frame = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+ \item{as.data.frame}{
+%% ~~Describe \code{as.data.frame} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model = "additive", subjects = NULL, as.data.frame = TRUE)
+{
+ assert.happy(h)
+ if ("genotype" == model) {
+ model <- "genotype.full"
+ }
+ hmodel <- model
+ submodel <- NULL
+ if (igrep("genotype", model)) {
+ submodel <- sub("genotype.", "", model)
+ hmodel <- "genotype"
+ }
+ if ("dominance" == model) {
+ hmodel <- "full"
+ }
+ mat <- happy.load.marker(h, marker = marker, model = hmodel)
+ if ("genotype" == hmodel) {
+ if (submodel \%in\% c("additive", "dominance", "hier")) {
+ mat <- as.matrix(genotype.to.hier(as.vector(mat)))
+ if ("additive" == submodel) {
+ mat <- mat[, 1]
+ }
+ else if ("dominance" == submodel) {
+ mat <- mat[, 2]
+ }
+ }
+ else if ("full" == submodel) {
+ mat <- as.factor(mat)
+ }
+ else if ("ped" == submodel) {
+ g <- genotype.to.count(as.vector(mat))
+ mat <- rep("00", length(g))
+ mat[g == 0] <- 11
+ mat[g == 1] <- 12
+ mat[g == 2] <- 22
+ }
+ else {
+ stop("Unknown model: ", model, "\n")
+ }
+ }
+ if (is.null(dim(mat))) {
+ mat <- as.array(mat)
+ }
+ if (!is.null(subjects)) {
+ subjects <- as.character(subjects)
+ i <- match(subjects, happy.get.subjects(h))
+ if (1 == length(dim(mat))) {
+ mat <- mat[i]
+ }
+ else {
+ mat <- matrix(mat[i, ], nrow = length(subjects),
+ ncol = ncol(mat), dimnames = list(subjects, colnames(mat)))
+ }
+ }
+ if ("dominance" == model) {
+ mat <- mat[, -(1:length(happy.get.strains(h)))]
+ }
+ if (as.data.frame) {
+ mat <- as.data.frame(mat)
+ if (1 == ncol(mat)) {
+ colnames(mat) <- model
+ }
+ if (!is.null(subjects)) {
+ rownames(mat) <- subjects
+ }
+ }
+ mat
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.design.old.Rd b/man/happy.get.design.old.Rd
new file mode 100644
index 0000000..1ce3e2e
--- /dev/null
+++ b/man/happy.get.design.old.Rd
@@ -0,0 +1,134 @@
+\name{happy.get.design.old}
+\alias{happy.get.design.old}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.design.old
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.design.old(h, marker, model = "additive", subjects = NULL, as.data.frame = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+ \item{as.data.frame}{
+%% ~~Describe \code{as.data.frame} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model = "additive", subjects = NULL, as.data.frame = TRUE)
+{
+ assert.happy(h)
+ if ("genotype" == model) {
+ model <- "genotype.full"
+ }
+ hmodel <- model
+ submodel <- NULL
+ if (igrep("genotype", model)) {
+ submodel <- sub("genotype.", "", model)
+ hmodel <- "genotype"
+ }
+ if ("dominance" == model) {
+ hmodel <- "full"
+ }
+ mat <- happy.load.marker(h, marker = marker, model = hmodel)
+ if ("genotype" == hmodel) {
+ if (submodel \%in\% c("additive", "dominance", "hier")) {
+ mat <- as.matrix(genotype.to.hier(as.vector(mat)))
+ if ("additive" == submodel) {
+ mat <- mat[, 1]
+ }
+ else if ("dominance" == submodel) {
+ mat <- mat[, 2]
+ }
+ }
+ else if ("full" == submodel) {
+ mat <- as.factor(mat)
+ }
+ else if ("ped" == submodel) {
+ g <- genotype.to.count(as.vector(mat))
+ mat <- rep("00", length(g))
+ mat[g == 0] <- 11
+ mat[g == 1] <- 12
+ mat[g == 2] <- 22
+ }
+ else {
+ stop("Unknown model: ", model, "\n")
+ }
+ }
+ if (is.null(dim(mat))) {
+ mat <- as.array(mat)
+ }
+ if (!is.null(subjects)) {
+ subjects <- as.character(subjects)
+ i <- match(subjects, happy.get.subjects(h))
+ if (1 == length(dim(mat))) {
+ mat <- mat[i]
+ }
+ else {
+ mat <- matrix(mat[i, ], nrow = length(subjects),
+ ncol = ncol(mat), dimnames = list(subjects, colnames(mat)))
+ }
+ }
+ if ("dominance" == model) {
+ mat <- mat[, -(1:length(happy.get.strains(h)))]
+ }
+ if (as.data.frame) {
+ mat <- as.data.frame(mat)
+ if (1 == ncol(mat)) {
+ colnames(mat) <- model
+ }
+ if (!is.null(subjects)) {
+ rownames(mat) <- subjects
+ }
+ }
+ mat
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.diplotype.tensor.Rd b/man/happy.get.diplotype.tensor.Rd
new file mode 100644
index 0000000..34caded
--- /dev/null
+++ b/man/happy.get.diplotype.tensor.Rd
@@ -0,0 +1,116 @@
+\name{happy.get.diplotype.tensor}
+\alias{happy.get.diplotype.tensor}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.diplotype.tensor
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.diplotype.tensor(h, marker, model, subjects = happy.get.subjects(h), simplify = FALSE, memoize = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+ \item{simplify}{
+%% ~~Describe \code{simplify} here~~
+}
+ \item{memoize}{
+%% ~~Describe \code{memoize} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model, subjects = happy.get.subjects(h),
+ simplify = FALSE, memoize = TRUE)
+{
+ assert.happy(h)
+ if (!model \%in\% c("full", "full.asymmetric")) {
+ stop("happy.get.diplotype.matrix() only implemented for full and full.asymmetric models\n")
+ }
+ subjects <- as.character(subjects)
+ if (happy.reserve.has.scratch(h) & memoize) {
+ if (happy.reserve.has(h, category = "scratch", object.name = "scratch.diplotype.tensor")) {
+ scratch = happy.reserve.get(h, category = "scratch",
+ object.name = "scratch.diplotype.tensor")
+ if (all(scratch$subjects == subjects) & scratch$model ==
+ model & scratch$marker == marker) {
+ return(scratch$tensor)
+ }
+ }
+ }
+ x.mat <- happy.get.design(h, marker = marker, model = model,
+ subjects = subjects, as.data.frame = FALSE)
+ strains = happy.get.strains(h)
+ num.strains = length(strains)
+ num.subjects = length(subjects)
+ mat.tensor = array(numeric(0), dim = c(num.strains, num.strains,
+ length(subjects)), dimnames = list(strains, strains,
+ subjects))
+ for (i in 1:num.subjects) {
+ if ("full" == model) {
+ mat.tensor[, , i] = happy.matrixop.full.to.diplotypes(x.mat[i,
+ ], num.strains)
+ }
+ else if ("full.asymmetric" == model) {
+ mat.tensor[, , i] <- happy.matrixop.full.asymmetric.diplotypes(x.mat[i,
+ ], num.strains)
+ }
+ }
+ if (happy.reserve.has.scratch(h) & memoize) {
+ scratch = list(tensor = mat.tensor, marker = marker,
+ model = model, subjects = subjects)
+ happy.reserve.put(h, category = "scratch", object.name = "scratch.diplotype.tensor",
+ object = scratch)
+ }
+ if (simplify & 1 == length(subjects)) {
+ return(mat.tensor[, , 1])
+ }
+ mat.tensor
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.first.marker.Rd b/man/happy.get.first.marker.Rd
new file mode 100644
index 0000000..dd19cb5
--- /dev/null
+++ b/man/happy.get.first.marker.Rd
@@ -0,0 +1,70 @@
+\name{happy.get.first.marker}
+\alias{happy.get.first.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.first.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.first.marker(h, chromosome = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chromosome}{
+%% ~~Describe \code{chromosome} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chromosome = NULL)
+{
+ if (!is.null(chromosome)) {
+ x <- character(length(chromosome))
+ for (i in 1:length(chromosome)) {
+ x[i] <- happy.get.markers(h, chromosome = chromosome[i])[1]
+ }
+ return(x)
+ }
+ else {
+ return(happy.get.markers(h)[1])
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.genome.location.Rd b/man/happy.get.genome.location.Rd
new file mode 100644
index 0000000..957515d
--- /dev/null
+++ b/man/happy.get.genome.location.Rd
@@ -0,0 +1,126 @@
+\name{happy.get.genome.location}
+\alias{happy.get.genome.location}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.genome.location
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.genome.location(h, markers = NULL, chr = NULL, bp = 0, pretty = TRUE, pad.bp = ifelse(pretty, 2e+07, 0), pad.position = ifelse(pretty, 10, 0))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{chr}{
+%% ~~Describe \code{chr} here~~
+}
+ \item{bp}{
+%% ~~Describe \code{bp} here~~
+}
+ \item{pretty}{
+%% ~~Describe \code{pretty} here~~
+}
+ \item{pad.bp}{
+%% ~~Describe \code{pad.bp} here~~
+}
+ \item{pad.position}{
+%% ~~Describe \code{pad.position} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers = NULL, chr = NULL, bp = 0, pretty = TRUE,
+ pad.bp = ifelse(pretty, 2e+07, 0), pad.position = ifelse(pretty,
+ 10, 0))
+{
+ all.markers <- happy.get.markers(h)
+ all.chroms <- happy.get.chromosome(h, all.markers)
+ all.pos <- happy.get.position(h, all.markers)
+ all.bp <- happy.get.bp(h, all.markers)
+ chroms <- happy.list.chromosomes(h)
+ last.pos <- 0
+ last.bp <- 0
+ chrom2add <- data.frame(rownames = chroms, pos = rep(0, length(chroms)),
+ bp = rep(0, length(chroms)))
+ chrom2addpos <- list()
+ chrom2addbp <- list()
+ first.marker <- happy.get.markers(h, chr = chroms[1])[1]
+ chrom2addpos[[chroms[1]]] <- -happy.get.position(h, first.marker)
+ chrom2addbp[[chroms[1]]] <- -happy.get.bp(h, first.marker)
+ for (i in 2:length(chroms)) {
+ first.marker <- happy.get.markers(h, chr = chroms[i])[1]
+ prev.chr.length <- happy.get.chromosome.length(h, chroms[i -
+ 1], scale = "cM", subtract.offset = FALSE)
+ curr.offset <- happy.get.position(h, first.marker)
+ chrom2addpos[[chroms[i]]] <- chrom2addpos[[chroms[i -
+ 1]]] + prev.chr.length - curr.offset + pad.position
+ prev.chr.length <- happy.get.chromosome.length(h, chroms[i -
+ 1], scale = "bp", subtract.offset = FALSE)
+ curr.offset <- happy.get.bp(h, first.marker)
+ chrom2addbp[[chroms[i]]] <- chrom2addbp[[chroms[i - 1]]] +
+ prev.chr.length - curr.offset + pad.bp
+ }
+ if (!is.null(markers)) {
+ marker.chr <- happy.get.chromosome(h, markers)
+ marker.pos <- happy.get.position(h, markers) + as.numeric(chrom2addpos[marker.chr])
+ marker.bp <- happy.get.bp(h, markers) + as.numeric(chrom2addbp[marker.chr])
+ return(data.frame(position = marker.pos, bp = marker.bp,
+ marker = as.character(markers)))
+ }
+ else if (!is.null(bp) & !is.null(chr)) {
+ chr <- as.character(chr)
+ if (length(chr) != length(bp)) {
+ if (1 == length(chr) & 1 < length(bp))
+ chr <- rep(chr, length(bp))
+ else if (1 < length(chr) & 1 == length(bp))
+ bp <- rep(bp, length(chr))
+ else {
+ stop("Incompatible bp and chr arguments: chr(",
+ paste(collapse = ",", chr), "), bp(", paste(collapse = ",",
+ bp), ")")
+ }
+ }
+ return(as.numeric(chrom2addbp[chr]) + bp)
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.genotype.Rd b/man/happy.get.genotype.Rd
new file mode 100644
index 0000000..7934047
--- /dev/null
+++ b/man/happy.get.genotype.Rd
@@ -0,0 +1,90 @@
+\name{happy.get.genotype}
+\alias{happy.get.genotype}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.genotype
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.genotype(ha, marker, model = NULL, subjects = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{ha}{
+%% ~~Describe \code{ha} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (ha, marker, model = NULL, subjects = NULL)
+{
+ genotypes <- hdesign(ha, as.character(marker), model = "genotype")
+ if (!is.null(subjects)) {
+ genotypes <- genotypes[match(subjects, happy.get.subjects(ha))]
+ }
+ if (is.null(model)) {
+ return(genotypes)
+ }
+ if ("additive" == model) {
+ return(genotype.to.count(genotypes))
+ }
+ if ("dominance" == model) {
+ return(genotype.to.hier(genotypes))
+ }
+ if ("full" == model) {
+ return(as.factor(genotypes))
+ }
+ if ("ped" == model) {
+ g <- genotype.to.count(genotypes)
+ s <- rep("00", length(g))
+ s[g == 0] <- 11
+ s[g == 1] <- 12
+ s[g == 2] <- 22
+ return(s)
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.interval.length.Rd b/man/happy.get.interval.length.Rd
new file mode 100644
index 0000000..c27275d
--- /dev/null
+++ b/man/happy.get.interval.length.Rd
@@ -0,0 +1,99 @@
+\name{happy.get.interval.length}
+\alias{happy.get.interval.length}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.interval.length
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.interval.length(h, markers, scale = "bp", fudge.bp = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{fudge.bp}{
+%% ~~Describe \code{fudge.bp} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, scale = "bp", fudge.bp = FALSE)
+{
+ d <- rep(NA, length(markers))
+ i <- match(markers, h$genotype$genome$marker)
+ if ("bp" == scale | "Mb" == scale) {
+ start <- h$genotype$genome$bp[i]
+ end <- h$genotype$genome$bp[i + 1]
+ d <- end - start
+ if (any(d < 0)) {
+ if (fudge.bp) {
+ fudges <- which(d < 0)
+ for (f in fudges) {
+ i.end <- which(h$genotype$genome$bp > h$genotype$genome$bp[i[f]] &
+ h$genotype$genome$chromosome == h$genotype$genome$chromosome[i[f]])[1]
+ d[f] <- h$genotype$genome$bp[i.end] - start[f]
+ }
+ }
+ else {
+ warning("Cannot calculate lengths for the following intervals",
+ " because their right-flank markers have a lower bp than their",
+ " left-flank markers:", paste(markers[which(d <
+ 0)], collapse = ", "), "\n")
+ d[0 > d] <- NA
+ }
+ }
+ if ("Mb" == scale)
+ d <- d/1e+06
+ }
+ else {
+ start <- h$genotype$genome$map[i]
+ end <- h$genotype$genome$map[i + 1]
+ d <- end - start
+ d[0 > d] <- NA
+ }
+ return(d)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.interval.midpoint.Rd b/man/happy.get.interval.midpoint.Rd
new file mode 100644
index 0000000..72fc851
--- /dev/null
+++ b/man/happy.get.interval.midpoint.Rd
@@ -0,0 +1,69 @@
+\name{happy.get.interval.midpoint}
+\alias{happy.get.interval.midpoint}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.interval.midpoint
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.interval.midpoint(h, markers, scale = "bp", fudge.bp = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{fudge.bp}{
+%% ~~Describe \code{fudge.bp} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, scale = "bp", fudge.bp = FALSE)
+{
+ p <- happy.get.location(h, markers, scale = scale)
+ p + happy.get.interval.length(h, markers, scale = scale,
+ fudge.bp = fudge.bp)/2
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.interval.over.Rd b/man/happy.get.interval.over.Rd
new file mode 100644
index 0000000..71d700d
--- /dev/null
+++ b/man/happy.get.interval.over.Rd
@@ -0,0 +1,111 @@
+\name{happy.get.interval.over}
+\alias{happy.get.interval.over}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.interval.over
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.interval.over(h, chromosome, x, scale = "cM", use.nearest.terminus = FALSE, boundary.choice = "l", fudge.bp = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chromosome}{
+%% ~~Describe \code{chromosome} here~~
+}
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{use.nearest.terminus}{
+%% ~~Describe \code{use.nearest.terminus} here~~
+}
+ \item{boundary.choice}{
+%% ~~Describe \code{boundary.choice} here~~
+}
+ \item{fudge.bp}{
+%% ~~Describe \code{fudge.bp} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chromosome, x, scale = "cM", use.nearest.terminus = FALSE,
+ boundary.choice = "l", fudge.bp = FALSE)
+{
+ chromosome <- rep(chromosome, length.out = length(x))
+ boundary.choice <- rep(boundary.choice, length.out = length(x))
+ markers <- happy.get.markers(h, chromosome = chromosome)
+ chrom <- happy.get.chromosome(h, markers)
+ range <- happy.get.interval.range(h, markers, scale = scale,
+ fudge.bp = fudge.bp)
+ overlap.marker <- rep(NA, length(x))
+ for (i in 1:length(x)) {
+ my.chrom <- chromosome[i]
+ my.loc <- x[i]
+ overlap.idx <- which(my.chrom == chrom & my.loc >= range[,
+ 1] & my.loc <= range[, 2])
+ if (2 == length(overlap.idx)) {
+ if (is.na(boundary.choice[i])) {
+ overlap.marker[i] <- NA
+ }
+ else if ("l" == boundary.choice[i]) {
+ overlap.marker[i] <- markers[overlap.idx[1]]
+ }
+ else {
+ overlap.marker[i] <- markers[overlap.idx[2]]
+ }
+ }
+ if (1 == length(overlap.idx)) {
+ overlap.marker[i] <- markers[overlap.idx]
+ }
+ if (0 == length(overlap.idx) & use.nearest.terminus) {
+ is.early <- my.loc < happy.get.location(h, scale = scale,
+ happy.get.first.marker(h, chromosome = my.chrom))
+ overlap.marker[i] <- ifelse(is.early, happy.get.first.marker(h,
+ chromosome = my.chrom), happy.get.last.marker(h,
+ chromosome = my.chrom))
+ }
+ }
+ overlap.marker
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.interval.range.Rd b/man/happy.get.interval.range.Rd
new file mode 100644
index 0000000..1182b37
--- /dev/null
+++ b/man/happy.get.interval.range.Rd
@@ -0,0 +1,76 @@
+\name{happy.get.interval.range}
+\alias{happy.get.interval.range}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.interval.range
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.interval.range(h, markers, scale = "cM", fudge.bp = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{fudge.bp}{
+%% ~~Describe \code{fudge.bp} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, scale = "cM", fudge.bp = FALSE)
+{
+ r <- happy.get.location(h, markers, scale = scale)
+ r <- cbind(r, r + happy.get.interval.length(h, markers, scale = scale,
+ fudge.bp = fudge.bp))
+ if ("bp" == scale | "Mb" == scale) {
+ one.base <- ifelse("Mb" == scale, 1e-06, 1)
+ r[, 2] <- r[, 2] - one.base
+ }
+ rownames(r) <- markers
+ colnames(r) <- c("begin", "end")
+ return(r)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.intervals.Rd b/man/happy.get.intervals.Rd
new file mode 100644
index 0000000..49c75d1
--- /dev/null
+++ b/man/happy.get.intervals.Rd
@@ -0,0 +1,61 @@
+\name{happy.get.intervals}
+\alias{happy.get.intervals}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.intervals
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.intervals(h, chromosome = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chromosome}{
+%% ~~Describe \code{chromosome} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chromosome = NULL)
+{
+ happy.get.markers(h, chromosome = chromosome, as.intervals = TRUE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.intervals.in.range.Rd b/man/happy.get.intervals.in.range.Rd
new file mode 100644
index 0000000..d6a9e3a
--- /dev/null
+++ b/man/happy.get.intervals.in.range.Rd
@@ -0,0 +1,112 @@
+\name{happy.get.intervals.in.range}
+\alias{happy.get.intervals.in.range}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.intervals.in.range
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.intervals.in.range(h, from = NULL, to = NULL, markers = NULL, chromosome = NULL, scale = "interval")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{from}{
+%% ~~Describe \code{from} here~~
+}
+ \item{to}{
+%% ~~Describe \code{to} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{chromosome}{
+%% ~~Describe \code{chromosome} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, from = NULL, to = NULL, markers = NULL, chromosome = NULL,
+ scale = "interval")
+{
+ if (is.null(from) & is.null(to)) {
+ return(happy.get.markers(h, chromosome = chromosome))
+ }
+ if (is.null(chromosome) & "interval" != scale) {
+ stop("Must specify chromosome= if using ", scale, "\n")
+ }
+ marker1 <- NULL
+ if (is.null(from)) {
+ marker1 <- happy.get.first.marker(h, chromosome = chromosome)
+ }
+ else {
+ if ("interval" == scale) {
+ if (!happy.has.markers(h, from)) {
+ stop("Could not find marker ", from, "\n")
+ }
+ marker1 <- from
+ }
+ else {
+ marker1 <- happy.get.interval.over(h, chromosome = chromosome,
+ x = from, scale = scale, use.nearest.terminus = TRUE)
+ }
+ }
+ marker2 <- NULL
+ if (is.null(from)) {
+ marker2 <- happy.get.last.marker(h, chromosome = chromosome)
+ }
+ else {
+ if ("interval" == scale) {
+ if (!happy.has.markers(h, to)) {
+ stop("Could not find marker ", to, "\n")
+ }
+ marker2 <- to
+ }
+ else {
+ marker2 <- happy.get.interval.over(h, chromosome = chromosome,
+ x = to, scale = scale, use.nearest.terminus = TRUE)
+ }
+ }
+ happy.get.markers.between(h, from = marker1, to = marker2)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.last.marker.Rd b/man/happy.get.last.marker.Rd
new file mode 100644
index 0000000..33a3cf6
--- /dev/null
+++ b/man/happy.get.last.marker.Rd
@@ -0,0 +1,65 @@
+\name{happy.get.last.marker}
+\alias{happy.get.last.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.last.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.last.marker(h, chromosome = NULL, as.intervals = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chromosome}{
+%% ~~Describe \code{chromosome} here~~
+}
+ \item{as.intervals}{
+%% ~~Describe \code{as.intervals} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chromosome = NULL, as.intervals = TRUE)
+{
+ m <- happy.get.markers(h, chromosome = chromosome, as.intervals = as.intervals)
+ m[length(m)]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.location.Rd b/man/happy.get.location.Rd
new file mode 100644
index 0000000..39b51e0
--- /dev/null
+++ b/man/happy.get.location.Rd
@@ -0,0 +1,65 @@
+\name{happy.get.location}
+\alias{happy.get.location}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.location
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.location(h, markers, scale = "bp")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, scale = "bp")
+{
+ switch(scale, bp = happy.get.bp(h, markers), Mb = happy.get.bp(h,
+ markers)/1e+06, cM = happy.get.position(h, markers))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.markers.Rd b/man/happy.get.markers.Rd
new file mode 100644
index 0000000..6fd092f
--- /dev/null
+++ b/man/happy.get.markers.Rd
@@ -0,0 +1,99 @@
+\name{happy.get.markers}
+\alias{happy.get.markers}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.markers
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.markers(h, chromosome = NULL, model = "genotype", as.intervals = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chromosome}{
+%% ~~Describe \code{chromosome} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+ \item{as.intervals}{
+%% ~~Describe \code{as.intervals} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chromosome = NULL, model = "genotype", as.intervals = TRUE)
+{
+ assert.happy.genome(h)
+ if (!all(happy.has.model(h, unique(c(model, "genotype"))))) {
+ i <- happy.has.model(h, unique(c(model, "genotype")))
+ stop("Model ", model[!i], " not loaded\n")
+ }
+ if (is.null(chromosome)) {
+ if (!as.intervals) {
+ return(h$genotype$markers)
+ }
+ if ("genotype" != model && as.intervals) {
+ return(h[[model]]$markers)
+ }
+ }
+ markers <- h$genotype$markers
+ terminii <- tapply(1:length(h$genotype$marker), h$genotype$chromosome,
+ tail, 1)
+ is.terminus <- rep(FALSE, length(markers))
+ is.terminus[terminii] <- TRUE
+ if (is.null(chromosome))
+ chromosome <- unique(h$genotype$chromosome)
+ if ("genotype" == model) {
+ if (as.intervals) {
+ return(markers[!is.terminus & h$genotype$chromosome \%in\%
+ chromosome])
+ }
+ return(markers[h$genotype$chromosome \%in\% chromosome])
+ }
+ if (as.intervals) {
+ return(h[[model]]$markers[h[[model]]$chromosome \%in\%
+ chromosome])
+ }
+ return(happy.get.markers(h, chromosome = chromosome, model = "genotype",
+ as.intervals = FALSE))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.markers.between.Rd b/man/happy.get.markers.between.Rd
new file mode 100644
index 0000000..2023a6c
--- /dev/null
+++ b/man/happy.get.markers.between.Rd
@@ -0,0 +1,98 @@
+\name{happy.get.markers.between}
+\alias{happy.get.markers.between}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.markers.between
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.markers.between(h, to = NULL, from = NULL, before = NULL, after = NULL, as.intervals = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{to}{
+%% ~~Describe \code{to} here~~
+}
+ \item{from}{
+%% ~~Describe \code{from} here~~
+}
+ \item{before}{
+%% ~~Describe \code{before} here~~
+}
+ \item{after}{
+%% ~~Describe \code{after} here~~
+}
+ \item{as.intervals}{
+%% ~~Describe \code{as.intervals} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, to = NULL, from = NULL, before = NULL, after = NULL,
+ as.intervals = TRUE)
+{
+ if (1 < length(to) | 1 < length(from) | 1 < length(before) |
+ 1 < length(after)) {
+ stop("Arguments must be of length 1\n")
+ }
+ markers <- happy.get.markers(h, as.intervals = as.intervals)
+ start <- NA
+ if (!is.null(after)) {
+ start <- which(after == markers) + 1
+ }
+ else if (!is.null(from)) {
+ start <- which(from == markers)
+ }
+ end <- NA
+ if (!is.null(before)) {
+ end <- which(before == markers) - 1
+ }
+ else if (!is.null(to)) {
+ end <- which(to == markers)
+ }
+ if (!force.logical(start) | !force.logical(end)) {
+ stop("Could not find start and end points for markers from=",
+ from, ", to=", to, ", before=", before, ", after=",
+ after, "\n")
+ }
+ markers[start:end]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.models.Rd b/man/happy.get.models.Rd
new file mode 100644
index 0000000..c64800f
--- /dev/null
+++ b/man/happy.get.models.Rd
@@ -0,0 +1,59 @@
+\name{happy.get.models}
+\alias{happy.get.models}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.models
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.models(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ assert.happy.genome(h)
+ intersect(names(h), happy.get.allowed.models())
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.next.marker.Rd b/man/happy.get.next.marker.Rd
new file mode 100644
index 0000000..c764328
--- /dev/null
+++ b/man/happy.get.next.marker.Rd
@@ -0,0 +1,86 @@
+\name{happy.get.next.marker}
+\alias{happy.get.next.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.next.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.next.marker(h, markers, as.intervals = TRUE, within.chr = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{as.intervals}{
+%% ~~Describe \code{as.intervals} here~~
+}
+ \item{within.chr}{
+%% ~~Describe \code{within.chr} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, as.intervals = TRUE, within.chr = FALSE)
+{
+ found <- happy.has.markers(h, markers)
+ if (!all(found)) {
+ stop("No such markers: ", paste(markers[!found], collapse = ", "),
+ "\n")
+ }
+ if (within.chr) {
+ out <- character(length(markers))
+ for (i in 1:length(markers)) {
+ chr.markers <- happy.get.markers(h, markers[i], as.intervals = as.intervals,
+ chr = happy.get.chromosome(h, markers[i]))
+ mi <- match(markers[i], chr.markers)
+ out[i] <- chr.markers[mi + 1]
+ }
+ return(out)
+ }
+ else {
+ all.markers <- happy.get.markers(h, as.intervals = as.intervals)
+ mi <- match(markers, all.markers)
+ return(all.markers[mi + 1])
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.position.Rd b/man/happy.get.position.Rd
new file mode 100644
index 0000000..2dc6215
--- /dev/null
+++ b/man/happy.get.position.Rd
@@ -0,0 +1,62 @@
+\name{happy.get.position}
+\alias{happy.get.position}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.position
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.position(ha, markers)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{ha}{
+%% ~~Describe \code{ha} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (ha, markers)
+{
+ assert.happy.genome(h)
+ ha$genotype$genome$map[match(markers, ha$genotype$genome$marker)]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.previous.marker.Rd b/man/happy.get.previous.marker.Rd
new file mode 100644
index 0000000..785e7e3
--- /dev/null
+++ b/man/happy.get.previous.marker.Rd
@@ -0,0 +1,73 @@
+\name{happy.get.previous.marker}
+\alias{happy.get.previous.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.previous.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.previous.marker(h, marker, as.intervals = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{as.intervals}{
+%% ~~Describe \code{as.intervals} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, as.intervals = TRUE)
+{
+ markers <- happy.get.markers(h, as.intervals = as.intervals)
+ i <- match(marker, markers)
+ if (any(is.na(i))) {
+ stop("No such markers: ", paste(marker[which(is.na(i))],
+ collapse = ", "), "\n")
+ }
+ if (any(1 == i)) {
+ stop("No marker previous to ", markers[1 == i], "\n")
+ }
+ markers[i - 1]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.reserve.limit.Rd b/man/happy.get.reserve.limit.Rd
new file mode 100644
index 0000000..a93acca
--- /dev/null
+++ b/man/happy.get.reserve.limit.Rd
@@ -0,0 +1,58 @@
+\name{happy.get.reserve.limit}
+\alias{happy.get.reserve.limit}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.reserve.limit
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.reserve.limit(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ h$DATA.MAX.MEMORY
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.reserved.marker.Rd b/man/happy.get.reserved.marker.Rd
new file mode 100644
index 0000000..fde49de
--- /dev/null
+++ b/man/happy.get.reserved.marker.Rd
@@ -0,0 +1,65 @@
+\name{happy.get.reserved.marker}
+\alias{happy.get.reserved.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.reserved.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.reserved.marker(h, marker, model)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model)
+{
+ hash.get(h[["DATA", exact = TRUE]][[model, exact = TRUE]],
+ marker)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.strains.Rd b/man/happy.get.strains.Rd
new file mode 100644
index 0000000..ea139ca
--- /dev/null
+++ b/man/happy.get.strains.Rd
@@ -0,0 +1,58 @@
+\name{happy.get.strains}
+\alias{happy.get.strains}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.strains
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.strains(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ h$strains
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.get.subjects.Rd b/man/happy.get.subjects.Rd
new file mode 100644
index 0000000..4545d6c
--- /dev/null
+++ b/man/happy.get.subjects.Rd
@@ -0,0 +1,58 @@
+\name{happy.get.subjects}
+\alias{happy.get.subjects}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.get.subjects
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.get.subjects(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ h$subjects
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.has.chromosomes.Rd b/man/happy.has.chromosomes.Rd
new file mode 100644
index 0000000..9774614
--- /dev/null
+++ b/man/happy.has.chromosomes.Rd
@@ -0,0 +1,64 @@
+\name{happy.has.chromosomes}
+\alias{happy.has.chromosomes}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.has.chromosomes
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.has.chromosomes(h, chroms, model = "genotype")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chroms}{
+%% ~~Describe \code{chroms} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chroms, model = "genotype")
+{
+ chroms \%in\% happy.list.chromosomes(h, model = model)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.has.markers.Rd b/man/happy.has.markers.Rd
new file mode 100644
index 0000000..82afc18
--- /dev/null
+++ b/man/happy.has.markers.Rd
@@ -0,0 +1,64 @@
+\name{happy.has.markers}
+\alias{happy.has.markers}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.has.markers
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.has.markers(h, markers, model = "additive")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, model = "additive")
+{
+ markers \%in\% happy.get.markers(h, model = model)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.has.model.Rd b/man/happy.has.model.Rd
new file mode 100644
index 0000000..27bf66a
--- /dev/null
+++ b/man/happy.has.model.Rd
@@ -0,0 +1,62 @@
+\name{happy.has.model}
+\alias{happy.has.model}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.has.model
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.has.model(h, model)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, model)
+{
+ assert.happy.genome(h)
+ model \%in\% happy.get.models(h)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.has.reserved.marker.Rd b/man/happy.has.reserved.marker.Rd
new file mode 100644
index 0000000..6d0f854
--- /dev/null
+++ b/man/happy.has.reserved.marker.Rd
@@ -0,0 +1,66 @@
+\name{happy.has.reserved.marker}
+\alias{happy.has.reserved.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.has.reserved.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.has.reserved.marker(h, marker, model)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model)
+{
+ if (is.null(h[["DATA", exact = TRUE]][[model, exact = TRUE]]))
+ return(FALSE)
+ hash.has(h$DATA[[model]], marker)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.has.subjects.Rd b/man/happy.has.subjects.Rd
new file mode 100644
index 0000000..203d31d
--- /dev/null
+++ b/man/happy.has.subjects.Rd
@@ -0,0 +1,61 @@
+\name{happy.has.subjects}
+\alias{happy.has.subjects}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.has.subjects
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.has.subjects(h, subjects)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{subjects}{
+%% ~~Describe \code{subjects} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, subjects)
+{
+ subjects \%in\% happy.get.subjects(h)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.init.reserve.Rd b/man/happy.init.reserve.Rd
new file mode 100644
index 0000000..87c1356
--- /dev/null
+++ b/man/happy.init.reserve.Rd
@@ -0,0 +1,74 @@
+\name{happy.init.reserve}
+\alias{happy.init.reserve}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.init.reserve
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.init.reserve(h, memory.limit.Mb = Inf, models = happy.get.models(h), auto.reserve = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{memory.limit.Mb}{
+%% ~~Describe \code{memory.limit.Mb} here~~
+}
+ \item{models}{
+%% ~~Describe \code{models} here~~
+}
+ \item{auto.reserve}{
+%% ~~Describe \code{auto.reserve} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, memory.limit.Mb = Inf, models = happy.get.models(h),
+ auto.reserve = TRUE)
+{
+ h$DATA <- list()
+ for (m in models) {
+ h$DATA[[m]] <- new.hash()
+ }
+ h$DATA.MAX.MEMORY <- memory.limit.Mb * 2^20
+ h$DATA.AUTO.ADD <- auto.reserve
+ h
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.is.auto.reserve.Rd b/man/happy.is.auto.reserve.Rd
new file mode 100644
index 0000000..0b584e2
--- /dev/null
+++ b/man/happy.is.auto.reserve.Rd
@@ -0,0 +1,60 @@
+\name{happy.is.auto.reserve}
+\alias{happy.is.auto.reserve}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.is.auto.reserve
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.is.auto.reserve(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ if (is.null(h$DATA.AUTO.ADD))
+ return(FALSE)
+ h$DATA.AUTO.ADD
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.list.chromosomes.Rd b/man/happy.list.chromosomes.Rd
new file mode 100644
index 0000000..c01361b
--- /dev/null
+++ b/man/happy.list.chromosomes.Rd
@@ -0,0 +1,72 @@
+\name{happy.list.chromosomes}
+\alias{happy.list.chromosomes}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.list.chromosomes
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.list.chromosomes(h, sort = TRUE, model = "genotype")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{sort}{
+%% ~~Describe \code{sort} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, sort = TRUE, model = "genotype")
+{
+ assert.happy(h)
+ chr <- unique(as.character(h[[model]]$genome$chromosome))
+ if (sort) {
+ ints <- suppressWarnings(as.integer(chr))
+ chars <- chr[is.na(ints)]
+ ints <- ints[!is.na(ints)]
+ chr <- c(as.character(sort(ints)), sort(chars))
+ }
+ chr
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.load.data.Rd b/man/happy.load.data.Rd
new file mode 100644
index 0000000..8b172d3
--- /dev/null
+++ b/man/happy.load.data.Rd
@@ -0,0 +1,83 @@
+\name{happy.load.data}
+\alias{happy.load.data}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.load.data
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.load.data(item, dir)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{item}{
+%% ~~Describe \code{item} here~~
+}
+ \item{dir}{
+%% ~~Describe \code{dir} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (item, dir)
+{
+ env <- new.env()
+ filename.pre2009 <- file.path(dir, "data", paste(item, "RData",
+ sep = "."))
+ if (file.exists(filename.pre2009)) {
+ load(filename.pre2009, env)
+ return(get(item, envir = env))
+ }
+ item.safe <- make.names(item)
+ filename.post2009 <- file.path(dir, paste(gsub("([[:upper:]])",
+ "@\\1", item.safe), "RData", sep = "."))
+ if (file.exists(filename.post2009)) {
+ load(filename.post2009, env)
+ return(get(item.safe, envir = env))
+ }
+ filename.hybrid <- file.path(dir, "data", paste(item.safe,
+ "RData", sep = "."))
+ if (file.exists(filename.hybrid)) {
+ load(filename.hybrid, env)
+ return(get(item.safe, envir = env))
+ }
+ stop("Could not find object file containing data for ", item,
+ " in package ", dir, ". Tried ", filename.pre2009, ", ",
+ filename.post2009, " and ", filename.hybrid, "\n")
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.load.genome.Rd b/man/happy.load.genome.Rd
new file mode 100644
index 0000000..f599f76
--- /dev/null
+++ b/man/happy.load.genome.Rd
@@ -0,0 +1,146 @@
+\name{happy.load.genome}
+\alias{happy.load.genome}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.load.genome
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.load.genome(dir, use.X = TRUE, chr = NULL, models = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{dir}{
+%% ~~Describe \code{dir} here~~
+}
+ \item{use.X}{
+%% ~~Describe \code{use.X} here~~
+}
+ \item{chr}{
+%% ~~Describe \code{chr} here~~
+}
+ \item{models}{
+%% ~~Describe \code{models} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (dir, use.X = TRUE, chr = NULL, models = NULL)
+{
+ if (!is.null(chr) & 0 == length(grep("chr", chr))) {
+ chr <- paste("chr", sep = "", chr)
+ }
+ if (is.null(models)) {
+ models <- intersect(happy.get.allowed.models(), list.subdirs(dir))
+ if (0 == length(models)) {
+ stop("No genome cache models present in ", dir, "\n")
+ }
+ if (!"genotype" \%in\% models) {
+ stop("Required genotype model is absent from cache dir ",
+ dir, "\n")
+ }
+ }
+ else {
+ models <- unique(c(models, "genotype"))
+ }
+ g <- list()
+ old.subjects <- NULL
+ old.strains <- NULL
+ for (model in models) {
+ pkgs <- c()
+ if (is.null(chr)) {
+ found.chr <- list.subdirs(paste(dir, "/", model,
+ sep = ""), pattern = "^chr")
+ if (0 == length(found.chr)) {
+ stop("Found no chromosomes for model ", model,
+ " in dir ", dir, "\n")
+ }
+ pkgs <- paste(dir, model, found.chr, sep = "/")
+ }
+ else {
+ pkgs <- paste(dir, model, chr, sep = "/")
+ }
+ markers <- c()
+ chromosome <- c()
+ map <- c()
+ pkgname <- c()
+ bp <- c()
+ for (p in pkgs) {
+ chromosome <- c(chromosome, happy.load.data("chromosome",
+ p))
+ m <- happy.load.data("markers", p)
+ markers <- c(markers, m)
+ map <- c(map, happy.load.data("map", p))
+ bp <- c(bp, happy.load.data("bp", p))
+ pkgname <- c(pkgname, rep(p, length(m)))
+ subjects <- happy.load.data("subjects", p)
+ strains <- happy.load.data("strains", p)
+ if (is.null(old.subjects)) {
+ old.subjects <- subjects
+ }
+ if (any(subjects != old.subjects)) {
+ cat("ERROR - subject names are inconsistent for chromosome ",
+ tail(chromosome, 1), "\n")
+ stop("FATAL HAPPY ERROR")
+ }
+ if (is.null(old.strains)) {
+ old.strains <- strains
+ }
+ if (any(strains != old.strains)) {
+ cat("ERROR - strain names are inconsistent for chromosome ",
+ chromosome, "\n")
+ stop("FATAL HAPPY ERROR")
+ }
+ }
+ genome <- data.frame(marker = I(as.character(markers)),
+ map = as.numeric(map), bp = as.numeric(bp), ddp = I(as.character(pkgname)),
+ chromosome = I(as.character(chromosome)))
+ g[[model]] <- list(genome = genome, subjects = subjects,
+ strains = strains, markers = as.character(genome$marker),
+ chromosome = as.character(genome$chromosome), map = genome$map,
+ design.matrix.colnames = happy.make.colnames(strains,
+ model = model))
+ }
+ g$subjects <- g$genotype$subjects
+ g$strains <- g$additive$strains
+ g$markers <- g$genotype$markers
+ g$haploid <- g$genotype$haploid
+ class(g) <- "happy.genome"
+ return(g)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.load.marker.Rd b/man/happy.load.marker.Rd
new file mode 100644
index 0000000..63cb405
--- /dev/null
+++ b/man/happy.load.marker.Rd
@@ -0,0 +1,136 @@
+\name{happy.load.marker}
+\alias{happy.load.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.load.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.load.marker(h, marker, model)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model)
+{
+ assert.happy.genome(h)
+ if (1 != length(marker)) {
+ stop("Must specify only one marker in happy.load.marker()\n")
+ }
+ if (1 != length(model)) {
+ stop("Must specify only one model in happy.load.marker()\n")
+ }
+ if (!happy.has.model(h, model)) {
+ stop("No such model ", model, " in happy object\n")
+ }
+ marker <- as.character(marker)
+ model <- as.character(model)
+ retval <- NULL
+ if (happy.has.reserved.marker(h, marker = marker, model = model)) {
+ retval <- happy.get.reserved.marker(h, marker = marker,
+ model = model)
+ }
+ else {
+ i <- which(h[[model]]$genome$marker == marker)
+ if (1 != length(i)) {
+ string <- paste("marker", marker, "for ", model,
+ " model.")
+ if (0 == length(i)) {
+ stop("Could not find ", string, "\n")
+ }
+ if (1 < length(i)) {
+ stop("Found multiple markers matching", string,
+ "\n")
+ }
+ }
+ pkg <- h[[model]]$genome$ddp[i]
+ max.tries <- 10
+ num.tries <- 0
+ sleep.time <- 1
+ has.loaded <- FALSE
+ retval <- NULL
+ while (!has.loaded & num.tries < max.tries) {
+ num.tries <- num.tries + 1
+ retval <- try(happy.load.data(marker, pkg))
+ if (!caught.error(retval)) {
+ if (!is.null(retval)) {
+ break
+ }
+ }
+ warning("Failed to load data for ", model, " ", marker,
+ ". Retrying after ", sleep.time, "s sleep...\n")
+ system(paste("sleep", sleep.time))
+ }
+ if (caught.error(retval)) {
+ stop("Error retrieving information via g.data.get() for marker ",
+ marker, "\n")
+ }
+ if (is.null(retval)) {
+ stop("Error: null data retrieved via g.data.get() for marker ",
+ marker, "\n")
+ }
+ if (!is.array(retval))
+ retval <- as.array(retval)
+ colnames(retval) <- happy.make.colnames(happy.get.strains(h),
+ model)
+ if ("full" == model) {
+ if (2 == round(sum(retval[1, ]), 1)) {
+ retval <- retval/2
+ }
+ }
+ }
+ if (happy.is.auto.reserve(h)) {
+ if (happy.get.reserve.limit(h) > happy.get.reserve.size(h)) {
+ happy.reserve.marker(h, marker = marker, model = model,
+ marker.data = retval)
+ }
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.make.colnames.Rd b/man/happy.make.colnames.Rd
new file mode 100644
index 0000000..98b5db8
--- /dev/null
+++ b/man/happy.make.colnames.Rd
@@ -0,0 +1,82 @@
+\name{happy.make.colnames}
+\alias{happy.make.colnames}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.make.colnames
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.make.colnames(strain.names, model)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{strain.names}{
+%% ~~Describe \code{strain.names} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (strain.names, model)
+{
+ if (!is.character(strain.names)) {
+ stop("Must pass strain.names as character vector to happy.make.colnames()\n")
+ }
+ num.strains <- length(strain.names)
+ if ("additive" == model) {
+ return(strain.names)
+ }
+ if ("genotype" == model) {
+ return(NULL)
+ }
+ diplotype.names <- matrix(kronecker(strain.names, strain.names,
+ paste, sep = "."), nrow = num.strains)
+ if ("full" == model) {
+ return(c(diag(diplotype.names), diplotype.names[upper.tri(diplotype.names,
+ diag = FALSE)]))
+ }
+ if ("full.asymmetric" == model) {
+ return(c(t(diplotype.names)))
+ }
+ else {
+ stop("No colnames defined for model ", model, "\n")
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.make.genome.location.Rd b/man/happy.make.genome.location.Rd
new file mode 100644
index 0000000..f15c136
--- /dev/null
+++ b/man/happy.make.genome.location.Rd
@@ -0,0 +1,111 @@
+\name{happy.make.genome.location}
+\alias{happy.make.genome.location}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.make.genome.location
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.make.genome.location(h, markers = NULL, chr = NULL, x = NULL, pretty = TRUE, scale = "cM", pad = switch(scale, cM = ifelse(pretty, 10, 0), bp = ifelse(pretty, 2e+07, 0)))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{chr}{
+%% ~~Describe \code{chr} here~~
+}
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{pretty}{
+%% ~~Describe \code{pretty} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{pad}{
+%% ~~Describe \code{pad} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers = NULL, chr = NULL, x = NULL, pretty = TRUE,
+ scale = "cM", pad = switch(scale, cM = ifelse(pretty, 10,
+ 0), bp = ifelse(pretty, 2e+07, 0)))
+{
+ chroms <- happy.list.chromosomes(h)
+ first.markers <- happy.get.first.marker(h, chroms)
+ chrom.offset <- rep(0, length(chroms))
+ chrom.offset[1] <- happy.get.location(h, first.markers[1],
+ scale = scale)
+ for (i in 2:length(chroms)) {
+ prev.chr.length <- happy.get.chromosome.length(h, chroms[i -
+ 1], scale = scale, subtract.offset = FALSE)
+ offset <- happy.get.location(h, first.markers[i], scale = scale)
+ chrom.offset[i] <- chrom.offset[i - 1] + prev.chr.length -
+ offset + pad
+ }
+ chrmap = data.frame(chr = I(chroms), offset = chrom.offset)
+ chrmap$start <- chrom.offset + happy.get.location(h, first.markers,
+ scale = scale)
+ chrmap$end <- chrom.offset + happy.get.chromosome.length(h,
+ chroms, scale = scale)
+ chrmap$midpoint <- 0.5 * (chrmap$start + chrmap$end)
+ retval <- list(chr.limits = chrmap)
+ if (!is.null(x) & !is.null(chr)) {
+ stopifnot(length(x) == length(chr))
+ x <- x + chrmap$offset[match(chr, chrmap$chr)]
+ retval$x <- x
+ }
+ if (!is.null(markers)) {
+ marker.chr <- happy.get.chromosome(h, markers)
+ i <- match(marker.chr, chrmap$chr)
+ z <- happy.get.location(h, markers, scale = scale)
+ z <- z + chrmap$offset[i]
+ retval$marker <- markers
+ retval$genome.location <- z
+ retval$scale <- scale
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.matrixop.diplotypes.to.full.Rd b/man/happy.matrixop.diplotypes.to.full.Rd
new file mode 100644
index 0000000..8e73949
--- /dev/null
+++ b/man/happy.matrixop.diplotypes.to.full.Rd
@@ -0,0 +1,73 @@
+\name{happy.matrixop.diplotypes.to.full}
+\alias{happy.matrixop.diplotypes.to.full}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.matrixop.diplotypes.to.full
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.matrixop.diplotypes.to.full(X, symmetric.X = FALSE, want.names = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{X}{
+%% ~~Describe \code{X} here~~
+}
+ \item{symmetric.X}{
+%% ~~Describe \code{symmetric.X} here~~
+}
+ \item{want.names}{
+%% ~~Describe \code{want.names} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (X, symmetric.X = FALSE, want.names = TRUE)
+{
+ if (!symmetric.X) {
+ X = 0.5 * (X + t(X))
+ }
+ f = c(diag(X), 2 * X[upper.tri(X, diag = FALSE)])
+ if (want.names & !is.null(colnames(X))) {
+ A = matrix(kronecker(colnames(X), colnames(X), FUN = paste,
+ sep = "."), nrow = ncol(X), byrow = TRUE)
+ names(f) = c(diag(A), A[upper.tri(A, diag = FALSE)])
+ }
+ f
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.matrixop.full.asymmetric.to.diplotypes.Rd b/man/happy.matrixop.full.asymmetric.to.diplotypes.Rd
new file mode 100644
index 0000000..71700a4
--- /dev/null
+++ b/man/happy.matrixop.full.asymmetric.to.diplotypes.Rd
@@ -0,0 +1,61 @@
+\name{happy.matrixop.full.asymmetric.to.diplotypes}
+\alias{happy.matrixop.full.asymmetric.to.diplotypes}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.matrixop.full.asymmetric.to.diplotypes
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.matrixop.full.asymmetric.to.diplotypes(x, num.strains)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{num.strains}{
+%% ~~Describe \code{num.strains} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, num.strains)
+{
+ matrix(x, nrow = num.strains)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.matrixop.full.to.diplotypes.Rd b/man/happy.matrixop.full.to.diplotypes.Rd
new file mode 100644
index 0000000..9ab719a
--- /dev/null
+++ b/man/happy.matrixop.full.to.diplotypes.Rd
@@ -0,0 +1,64 @@
+\name{happy.matrixop.full.to.diplotypes}
+\alias{happy.matrixop.full.to.diplotypes}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.matrixop.full.to.diplotypes
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.matrixop.full.to.diplotypes(x, num.strains)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{num.strains}{
+%% ~~Describe \code{num.strains} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, num.strains)
+{
+ m <- matrix(0, ncol = num.strains, nrow = num.strains)
+ diag(m) <- x[1:num.strains]
+ m[upper.tri(m, diag = FALSE)] = x[(num.strains + 1):length(x)]
+ 0.5 * (m + t(m))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.num.strains.Rd b/man/happy.num.strains.Rd
new file mode 100644
index 0000000..f6024ec
--- /dev/null
+++ b/man/happy.num.strains.Rd
@@ -0,0 +1,58 @@
+\name{happy.num.strains}
+\alias{happy.num.strains}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.num.strains
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.num.strains(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ length(happy.get.strains(h))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.plot.intervals.Rd b/man/happy.plot.intervals.Rd
new file mode 100644
index 0000000..c8b7513
--- /dev/null
+++ b/man/happy.plot.intervals.Rd
@@ -0,0 +1,261 @@
+\name{happy.plot.intervals}
+\alias{happy.plot.intervals}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.plot.intervals
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.plot.intervals(h, loci = NULL, y = NULL, chr = NULL, scale = "cM", loci.lim = NULL, ylim = c(0, 1), add = FALSE, axes = !add, axis.x = axes, axis.y = axes, type = "l", lty = 1, na.edge.lty = 2, fill = NULL, na.edge.density = NA, missing.y = NA, draw.edge.support = FALSE, flag.missing.y.line = function(x, ...) {
+}, xlab = scale, ylab = "", ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{loci}{
+%% ~~Describe \code{loci} here~~
+}
+ \item{y}{
+%% ~~Describe \code{y} here~~
+}
+ \item{chr}{
+%% ~~Describe \code{chr} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{loci.lim}{
+%% ~~Describe \code{loci.lim} here~~
+}
+ \item{ylim}{
+%% ~~Describe \code{ylim} here~~
+}
+ \item{add}{
+%% ~~Describe \code{add} here~~
+}
+ \item{axes}{
+%% ~~Describe \code{axes} here~~
+}
+ \item{axis.x}{
+%% ~~Describe \code{axis.x} here~~
+}
+ \item{axis.y}{
+%% ~~Describe \code{axis.y} here~~
+}
+ \item{type}{
+%% ~~Describe \code{type} here~~
+}
+ \item{lty}{
+%% ~~Describe \code{lty} here~~
+}
+ \item{na.edge.lty}{
+%% ~~Describe \code{na.edge.lty} here~~
+}
+ \item{fill}{
+%% ~~Describe \code{fill} here~~
+}
+ \item{na.edge.density}{
+%% ~~Describe \code{na.edge.density} here~~
+}
+ \item{missing.y}{
+%% ~~Describe \code{missing.y} here~~
+}
+ \item{draw.edge.support}{
+%% ~~Describe \code{draw.edge.support} here~~
+}
+ \item{flag.missing.y.line}{
+%% ~~Describe \code{flag.missing.y.line} here~~
+}
+ \item{xlab}{
+%% ~~Describe \code{xlab} here~~
+}
+ \item{ylab}{
+%% ~~Describe \code{ylab} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, loci = NULL, y = NULL, chr = NULL, scale = "cM",
+ loci.lim = NULL, ylim = c(0, 1), add = FALSE, axes = !add,
+ axis.x = axes, axis.y = axes, type = "l", lty = 1, na.edge.lty = 2,
+ fill = NULL, na.edge.density = NA, missing.y = NA, draw.edge.support = FALSE,
+ flag.missing.y.line = function(x, ...) {
+ }, xlab = scale, ylab = "", ...)
+{
+ if (scale != "cM") {
+ happy.check.bp(h)
+ }
+ if (!all(force.logical(chr)) & !all(force.logical(loci))) {
+ stop("One or both of Chr or loci must be completely defined in happy.plot.intervals\n")
+ }
+ if (is.null(y)) {
+ y <- rep(0, length(loci))
+ }
+ else if (1 == length(y) & 1 < length(loci)) {
+ y <- rep(y, length(loci))
+ }
+ else if (length(y) != length(loci)) {
+ stop("Length of x and y differ: ", length(loci), " loci and ",
+ length(y), " y values\n")
+ }
+ if (!all(force.logical(chr))) {
+ chr <- happy.get.chromosome(h, loci)
+ }
+ all.chr <- happy.list.chromosomes(h)[happy.list.chromosomes(h) \%in\%
+ unique(chr)]
+ is.multiple.chroms <- 1 < length(chr)
+ pad.loci <- NULL
+ xlim <- NULL
+ if (!is.multiple.chroms) {
+ if (is.null(loci.lim)) {
+ loci.lim <- c(happy.get.first.marker(h, chr = chr),
+ happy.get.last.marker(h, chr = chr))
+ }
+ if (0 > diff(happy.get.location(h, loci.lim, scale = scale))) {
+ loci.lim <- rev(loci.lim)
+ }
+ pad.loci <- happy.get.markers.between(h, from = loci.lim[1],
+ to = loci.lim[2])
+ xmat <- as.matrix(happy.get.interval.range(h, pad.loci,
+ scale = scale))
+ xlim <- c(xmat[1, 1], tail(xmat, 1)[1, 2])
+ if (!add) {
+ plot(xlim, ylim, type = "n", axes = FALSE, xlab = xlab,
+ ylab = ylab, ylim = ylim, ...)
+ if (axis.y)
+ axis(2, las = 1)
+ if (axis.x)
+ axis(1)
+ }
+ }
+ else {
+ pad.loci <- happy.get.markers(h, chr = all.chr)
+ gloc.list <- happy.make.genome.location(h, markers = pad.loci,
+ scale = scale)
+ locus.begin <- gloc.list$genome.location
+ locus.end <- locus.begin + happy.get.interval.length(h,
+ pad.loci, scale = scale)
+ xmat <- cbind(locus.begin, locus.end)
+ xlim <- c(xmat[1, 1], tail(xmat, 1)[1, 2])
+ if (!add) {
+ plot(xlim, ylim, type = "n", axes = FALSE, xlab = xlab,
+ ylab = ylab, ylim = ylim, ...)
+ if (axis.y)
+ axis(2, las = 1)
+ if (axis.x) {
+ chr.limits <- gloc.list$chr.limits
+ for (ic in 1:nrow(chr.limits)) {
+ axis(1, at = chr.limits[ic, c("start", "end")],
+ labels = c("", ""))
+ axis(1, at = chr.limits$midpoint[ic], labels = chr.limits$chr[ic],
+ lty = 0)
+ }
+ }
+ }
+ }
+ if (!is.null(loci)) {
+ pad.y <- rep(missing.y, length(pad.loci))
+ pad.y[match(loci, pad.loci)] <- y
+ y <- pad.y
+ loci <- pad.loci
+ }
+ if (force.logical(fill[1])) {
+ fill <- rep(fill, length.out = length(loci))
+ for (i in 1:length(loci)) {
+ if (is.na(y[i]))
+ next
+ if (1 == i | length(loci) == i | any(is.na(y[i -
+ 1])) | is.na(y[i + 1])) {
+ polygonh(xmat[i, 1:2], ylim[1], y[i] - ylim[1],
+ col = fill[i], density = na.edge.density)
+ }
+ else if (y[i] != ylim[1]) {
+ polygonh(xmat[i, 1:2], ylim[1], y[i] - ylim[1],
+ col = fill[i], density = NA)
+ }
+ }
+ }
+ if ("n" != type) {
+ max.coords <- 2 * length(loci) + 1
+ from.x <- numeric(max.coords)
+ from.y <- numeric(max.coords)
+ to.x <- numeric(max.coords)
+ to.y <- numeric(max.coords)
+ k <- 1
+ for (i in 1:length(loci)) {
+ if (is.na(y[i])) {
+ flag.missing.y.line(xmat[i, c(1, 2)], locus = loci[i],
+ ylim = ylim)
+ next
+ }
+ from.x[k] <- xmat[i, 1]
+ from.y[k] <- y[i]
+ to.x[k] <- xmat[i, 2]
+ to.y[k] <- y[i]
+ k <- k + 1
+ if (1 < i) {
+ if (is.finite(y[i - 1]) | force.logical(y[i -
+ 1] != y[i], na = FALSE)) {
+ from.x[k] <- xmat[i, 1]
+ from.y[k] <- y[i - 1]
+ to.x[k] <- xmat[i, 1]
+ to.y[k] <- y[i]
+ k <- k + 1
+ }
+ else if (draw.edge.support) {
+ lines(rep(xmat[i, 1], 2), c(ylim[1], y[i]),
+ type = type, lty = na.edge.lty, ...)
+ }
+ }
+ if (length(loci) == i | is.na(y[i + 1])) {
+ if (draw.edge.support) {
+ lines(rep(xmat[i, 2], 2), c(ylim[1], y[i]),
+ type = type, lty = na.edge.lty, ...)
+ }
+ }
+ }
+ segments(from.x, from.y, to.x, to.y, lty = lty, ...)
+ }
+ invisible()
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.plot.ladder.Rd b/man/happy.plot.ladder.Rd
new file mode 100644
index 0000000..be244fc
--- /dev/null
+++ b/man/happy.plot.ladder.Rd
@@ -0,0 +1,146 @@
+\name{happy.plot.ladder}
+\alias{happy.plot.ladder}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.plot.ladder
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.plot.ladder(h, chr.list, scale, add = FALSE, chr.xaxis.col = "gray50", chr.yaxis.cex = 0.8, yspace = diff(ylim) * 0.1, col = "black", draw.edge.support = FALSE, fill = FALSE, lty = 1, type = "l", ylim = c(0, 1), ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{chr.list}{
+%% ~~Describe \code{chr.list} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{add}{
+%% ~~Describe \code{add} here~~
+}
+ \item{chr.xaxis.col}{
+%% ~~Describe \code{chr.xaxis.col} here~~
+}
+ \item{chr.yaxis.cex}{
+%% ~~Describe \code{chr.yaxis.cex} here~~
+}
+ \item{yspace}{
+%% ~~Describe \code{yspace} here~~
+}
+ \item{col}{
+%% ~~Describe \code{col} here~~
+}
+ \item{draw.edge.support}{
+%% ~~Describe \code{draw.edge.support} here~~
+}
+ \item{fill}{
+%% ~~Describe \code{fill} here~~
+}
+ \item{lty}{
+%% ~~Describe \code{lty} here~~
+}
+ \item{type}{
+%% ~~Describe \code{type} here~~
+}
+ \item{ylim}{
+%% ~~Describe \code{ylim} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, chr.list, scale, add = FALSE, chr.xaxis.col = "gray50",
+ chr.yaxis.cex = 0.8, yspace = diff(ylim) * 0.1, col = "black",
+ draw.edge.support = FALSE, fill = FALSE, lty = 1, type = "l",
+ ylim = c(0, 1), ...)
+{
+ chr.names <- names(chr.list)
+ longest.chr <- chr.names[which.max(happy.get.chromosome.length(h,
+ chr.names, scale = scale))]
+ yrange <- diff(ylim)
+ true.ylim <- c(ylim[1], ylim[1] + (yrange + yspace) * length(chr.list) -
+ yspace)
+ y.offset <- rev(ylim[1] + ((1:length(chr.list)) - 1) * (yrange +
+ yspace))
+ if (!add) {
+ happy.plot.intervals(h, chr = longest.chr, ylim = true.ylim,
+ type = "n", scale = scale, axis.y = FALSE, ...)
+ pretty.ylim.value <- round(ylim, 0)
+ pretty.ylim.pos <- pretty.ylim.value + y.offset[1]
+ mtext(pretty.ylim.value, at = pretty.ylim.pos, side = 2,
+ col = chr.xaxis.col, las = 1, line = -1, cex = chr.yaxis.cex)
+ for (ic in 1:length(chr.list)) {
+ chr <- chr.names[ic]
+ chr.y.offset <- y.offset[ic]
+ chr.ylim <- c(chr.y.offset, chr.y.offset + yrange)
+ chr.xlim <- c(happy.get.interval.range(h, happy.get.first.marker(h,
+ chr = chr), scale = scale)[1], happy.get.interval.range(h,
+ happy.get.last.marker(h, chr = chr), scale = scale)[2])
+ lines(chr.xlim, rep(chr.y.offset[1], 2), col = chr.xaxis.col)
+ mtext(chr, side = 2, at = mean(chr.ylim), las = 1)
+ }
+ }
+ for (ic in 1:length(chr.list)) {
+ chr <- chr.names[ic]
+ chr.y.offset <- y.offset[ic]
+ chr.ylim <- c(chr.y.offset, chr.y.offset + yrange)
+ if (!force.logical(2 <= ncol(chr.list[[ic]])))
+ next
+ data <- chr.list[[ic]]
+ if (0 == nrow(data))
+ next
+ ny <- ncol(data) - 1
+ for (iy in 1:ny) {
+ happy.plot.intervals(add = TRUE, h, chr = chr, loci = data[,
+ 1], y = data[, iy + 1] + chr.y.offset, ylim = chr.ylim,
+ col = ifelse(ny == length(col), col[iy], col),
+ draw.edge.support = ifelse(ny == length(draw.edge.support),
+ draw.edge.support[iy], draw.edge.support),
+ fill = ifelse(ny == length(fill), fill[iy], fill),
+ lty = ifelse(ny == length(lty), lty[iy], lty),
+ type = type, scale = scale, ...)
+ }
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.plot.ladder.chr.list.Rd b/man/happy.plot.ladder.chr.list.Rd
new file mode 100644
index 0000000..5d1d5d4
--- /dev/null
+++ b/man/happy.plot.ladder.chr.list.Rd
@@ -0,0 +1,80 @@
+\name{happy.plot.ladder.chr.list}
+\alias{happy.plot.ladder.chr.list}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.plot.ladder.chr.list
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.plot.ladder.chr.list(chr.names, data, chr.col = "chr", wanted.cols = "locus", constant.cols = list())
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{chr.names}{
+%% ~~Describe \code{chr.names} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{chr.col}{
+%% ~~Describe \code{chr.col} here~~
+}
+ \item{wanted.cols}{
+%% ~~Describe \code{wanted.cols} here~~
+}
+ \item{constant.cols}{
+%% ~~Describe \code{constant.cols} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (chr.names, data, chr.col = "chr", wanted.cols = "locus",
+ constant.cols = list())
+{
+ chr.list <- list()
+ for (chr in chr.names) {
+ i <- data[, chr.col] == as.character(chr)
+ d <- data[i, wanted.cols]
+ for (nam in names(constant.cols)) {
+ d[, nam] <- constant.cols[[nam]]
+ }
+ chr.list[[chr]] <- d
+ }
+ chr.list
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.exists.Rd b/man/happy.reserve.exists.Rd
new file mode 100644
index 0000000..fe44751
--- /dev/null
+++ b/man/happy.reserve.exists.Rd
@@ -0,0 +1,58 @@
+\name{happy.reserve.exists}
+\alias{happy.reserve.exists}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.exists
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.exists(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ !is.null(h$DATA)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.get.Rd b/man/happy.reserve.get.Rd
new file mode 100644
index 0000000..e319c5c
--- /dev/null
+++ b/man/happy.reserve.get.Rd
@@ -0,0 +1,64 @@
+\name{happy.reserve.get}
+\alias{happy.reserve.get}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.get
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.get(h, category, object.name)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{category}{
+%% ~~Describe \code{category} here~~
+}
+ \item{object.name}{
+%% ~~Describe \code{object.name} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, category, object.name)
+{
+ hash.get(h$DATA[[category, exact = TRUE]], object.name)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.has.Rd b/man/happy.reserve.has.Rd
new file mode 100644
index 0000000..e8819b6
--- /dev/null
+++ b/man/happy.reserve.has.Rd
@@ -0,0 +1,73 @@
+\name{happy.reserve.has}
+\alias{happy.reserve.has}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.has
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.has(h, category, object.name = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{category}{
+%% ~~Describe \code{category} here~~
+}
+ \item{object.name}{
+%% ~~Describe \code{object.name} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, category, object.name = NULL)
+{
+ if (!happy.reserve.exists(h)) {
+ return(FALSE)
+ }
+ if (is.null(h[["DATA", exact = TRUE]][[category, exact = TRUE]])) {
+ return(FALSE)
+ }
+ if (is.null(object.name)) {
+ return(TRUE)
+ }
+ hash.has(h$DATA[[category, exact = TRUE]], object.name)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.has.scratch.Rd b/man/happy.reserve.has.scratch.Rd
new file mode 100644
index 0000000..bae99dd
--- /dev/null
+++ b/man/happy.reserve.has.scratch.Rd
@@ -0,0 +1,58 @@
+\name{happy.reserve.has.scratch}
+\alias{happy.reserve.has.scratch}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.has.scratch
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.has.scratch(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ !is.null(h$DATA[["scratch", exact = TRUE]])
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.marker.Rd b/man/happy.reserve.marker.Rd
new file mode 100644
index 0000000..6fab44d
--- /dev/null
+++ b/man/happy.reserve.marker.Rd
@@ -0,0 +1,76 @@
+\name{happy.reserve.marker}
+\alias{happy.reserve.marker}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.marker
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.marker(h, marker, model, marker.data = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{marker}{
+%% ~~Describe \code{marker} here~~
+}
+ \item{model}{
+%% ~~Describe \code{model} here~~
+}
+ \item{marker.data}{
+%% ~~Describe \code{marker.data} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, marker, model, marker.data = NULL)
+{
+ if (is.null(h$DATA[[model, exact = TRUE]])) {
+ stop("Cannot reserve marker ", marker, " for model ",
+ model, " because memory cache has not been initialized\n")
+ }
+ if (is.null(marker.data)) {
+ marker.data <- happy.load.marker(h, marker = marker,
+ model = model)
+ }
+ data.hash <- h$DATA[[model, exact = TRUE]]
+ hash.put(data.hash, marker, marker.data)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.markers.Rd b/man/happy.reserve.markers.Rd
new file mode 100644
index 0000000..e0a5f24
--- /dev/null
+++ b/man/happy.reserve.markers.Rd
@@ -0,0 +1,102 @@
+\name{happy.reserve.markers}
+\alias{happy.reserve.markers}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.markers
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.markers(h, markers, models, verbose = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{models}{
+%% ~~Describe \code{models} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, markers, models, verbose = TRUE)
+{
+ assert.happy.genome(h)
+ if (length(markers) != length(models)) {
+ stop("Number of markers must match number of models\n")
+ }
+ markers <- as.character(markers)
+ models <- as.character(models)
+ cat("Reserving data for ", length(markers), " marker-model combinations in memory\n")
+ mem.size <- 0
+ memory.limit.Mb <- happy.get.reserve.limit(h)
+ if (0 < length(h$DATA)) {
+ mem.size <- happy.get.reserve.size(h)/2^20
+ }
+ for (i in 1:length(markers)) {
+ if (happy.has.reserved.marker(h, marker = markers[i],
+ model = models[i])) {
+ next
+ }
+ marker.data <- happy.load.marker(h, markers[i], models[i])
+ mem.size <- mem.size + object.size(marker.data)/2^20
+ if (memory.limit.Mb <= mem.size) {
+ warning(paste("Reached memory limit", round(mem.size,
+ 3), "Mb / ", memory.limit.Mb, "Mb for marker reserve with",
+ i, "/", length(markers), "markers. The remaining",
+ length(markers) - i, "markers will be accessed through disk I/O\n"))
+ break
+ }
+ happy.reserve.marker(h, marker = markers[i], model = models[i],
+ marker.data = marker.data)
+ if (verbose) {
+ cat("[", i, "]", sep = "")
+ }
+ }
+ if (verbose)
+ cat("\n")
+ cat("Marker data consumes", round(mem.size, 3), "Mb\n")
+ h
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.memory.usage.Rd b/man/happy.reserve.memory.usage.Rd
new file mode 100644
index 0000000..95cbdb4
--- /dev/null
+++ b/man/happy.reserve.memory.usage.Rd
@@ -0,0 +1,61 @@
+\name{happy.reserve.memory.usage}
+\alias{happy.reserve.memory.usage}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.memory.usage
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.memory.usage(h)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h)
+{
+ if (!happy.reserve.exists(h)) {
+ stop("Reserve does not exist!\n")
+ }
+ sum(sapply(h$DATA, hash.memory.usage))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.reserve.put.Rd b/man/happy.reserve.put.Rd
new file mode 100644
index 0000000..a718f1b
--- /dev/null
+++ b/man/happy.reserve.put.Rd
@@ -0,0 +1,74 @@
+\name{happy.reserve.put}
+\alias{happy.reserve.put}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.reserve.put
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.reserve.put(h, category, object.name, object)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{category}{
+%% ~~Describe \code{category} here~~
+}
+ \item{object.name}{
+%% ~~Describe \code{object.name} here~~
+}
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, category, object.name, object)
+{
+ if (!happy.reserve.exists(h)) {
+ stop("Cannot reserve object because reserve is not initialized\n")
+ }
+ if (is.null(h$DATA[[category, exact = TRUE]])) {
+ stop("Cannot reserve object because category ", category,
+ " does not exist\n")
+ }
+ hash.put(h$DATA[[category, exact = TRUE]], object.name, object)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/happy.set.auto.reserve.Rd b/man/happy.set.auto.reserve.Rd
new file mode 100644
index 0000000..5286420
--- /dev/null
+++ b/man/happy.set.auto.reserve.Rd
@@ -0,0 +1,62 @@
+\name{happy.set.auto.reserve}
+\alias{happy.set.auto.reserve}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{happy.set.auto.reserve
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+happy.set.auto.reserve(h, bool)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{bool}{
+%% ~~Describe \code{bool} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, bool)
+{
+ h$DATA.AUTO.ADD <- bool
+ h
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hasS3method.Rd b/man/hasS3method.Rd
new file mode 100644
index 0000000..df0516f
--- /dev/null
+++ b/man/hasS3method.Rd
@@ -0,0 +1,63 @@
+\name{hasS3method}
+\alias{hasS3method}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hasS3method
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hasS3method(f, x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{f}{
+%% ~~Describe \code{f} here~~
+}
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (f, x)
+{
+ if (is.object(x))
+ x <- oldClass(x)
+ !is.null(getS3method(f, x, optional = TRUE))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hasS4method.Rd b/man/hasS4method.Rd
new file mode 100644
index 0000000..179959d
--- /dev/null
+++ b/man/hasS4method.Rd
@@ -0,0 +1,68 @@
+\name{hasS4method}
+\alias{hasS4method}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hasS4method
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hasS4method(f, x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{f}{
+%% ~~Describe \code{f} here~~
+}
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (f, x)
+{
+ if (is.object(x))
+ x <- class(x)
+ for (cl in x) {
+ m <- selectMethod(f, optional = TRUE, signature = signature(object = cl))
+ if (!is.null(m))
+ return(TRUE)
+ }
+ FALSE
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hash.get.Rd b/man/hash.get.Rd
new file mode 100644
index 0000000..e89a7fb
--- /dev/null
+++ b/man/hash.get.Rd
@@ -0,0 +1,61 @@
+\name{hash.get}
+\alias{hash.get}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hash.get
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hash.get(hash, key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{hash}{
+%% ~~Describe \code{hash} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (hash, key)
+{
+ get(as.character(key), envir = hash, inherits = FALSE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hash.has.Rd b/man/hash.has.Rd
new file mode 100644
index 0000000..9953cc7
--- /dev/null
+++ b/man/hash.has.Rd
@@ -0,0 +1,61 @@
+\name{hash.has}
+\alias{hash.has}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hash.has
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hash.has(hash, key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{hash}{
+%% ~~Describe \code{hash} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (hash, key)
+{
+ exists(as.character(key), envir = hash, inherits = FALSE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hash.keys.Rd b/man/hash.keys.Rd
new file mode 100644
index 0000000..76fb77e
--- /dev/null
+++ b/man/hash.keys.Rd
@@ -0,0 +1,58 @@
+\name{hash.keys}
+\alias{hash.keys}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hash.keys
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hash.keys(hash)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{hash}{
+%% ~~Describe \code{hash} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (hash)
+{
+ ls(envir = hash)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hash.memory.usage.Rd b/man/hash.memory.usage.Rd
new file mode 100644
index 0000000..19cb494
--- /dev/null
+++ b/man/hash.memory.usage.Rd
@@ -0,0 +1,62 @@
+\name{hash.memory.usage}
+\alias{hash.memory.usage}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hash.memory.usage
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hash.memory.usage(hash)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{hash}{
+%% ~~Describe \code{hash} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (hash)
+{
+ total <- 0
+ for (k in hash.keys(hash)) {
+ total <- total + object.size(hash.get(hash, k))
+ }
+ total
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hash.put.Rd b/man/hash.put.Rd
new file mode 100644
index 0000000..2dd85b7
--- /dev/null
+++ b/man/hash.put.Rd
@@ -0,0 +1,64 @@
+\name{hash.put}
+\alias{hash.put}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hash.put
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hash.put(hash, key, value)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{hash}{
+%% ~~Describe \code{hash} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+ \item{value}{
+%% ~~Describe \code{value} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (hash, key, value)
+{
+ assign(as.character(key), envir = hash, value = value)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/hash.remove.Rd b/man/hash.remove.Rd
new file mode 100644
index 0000000..4a7368f
--- /dev/null
+++ b/man/hash.remove.Rd
@@ -0,0 +1,61 @@
+\name{hash.remove}
+\alias{hash.remove}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{hash.remove
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+hash.remove(hash, key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{hash}{
+%% ~~Describe \code{hash} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (hash, key)
+{
+ rm(envir = hash, list = key)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/ifow.Rd b/man/ifow.Rd
new file mode 100644
index 0000000..21aaa41
--- /dev/null
+++ b/man/ifow.Rd
@@ -0,0 +1,66 @@
+\name{ifow}
+\alias{ifow}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{If-otherwise statement alternative to ifelse
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+ifow(test, yes, no)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{test}{
+ An expression evaluating to \code{TRUE} or \code{FALSE}.
+}
+ \item{yes}{
+ An object or expression to be returned if \code{test} evaluates to \code{TRUE}.
+}
+ \item{no}{
+ An object or expression to be returned if \code{test} evaluates to \code{FALSE}.
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (test, yes, no)
+{
+ if (test) {
+ return(yes)
+ }
+ no
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/igrep.Rd b/man/igrep.Rd
new file mode 100644
index 0000000..012995f
--- /dev/null
+++ b/man/igrep.Rd
@@ -0,0 +1,73 @@
+\name{igrep}
+\alias{igrep}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Wrapper for \code{grep} providing a logical vector output
+}
+\description{
+A pass-through method for \code{grep} that provides output as a logical vector indicating which elements matched. If argument \code{logical=FALSE} then simply returns the output from standard \code{grep}.
+}
+\usage{
+igrep(pattern, x, ..., value = FALSE, logical = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{pattern}{
+ As for the standard function \code{grep}.
+}
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{\dots}{
+ Arguments to \code{grep}
+}
+ \item{value}{
+%% ~~Describe \code{value} here~~
+}
+ \item{logical}{
+%% ~~Describe \code{logical} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (pattern, x, ..., value = FALSE, logical = TRUE)
+{
+ if (!value & logical) {
+ indices <- grep(pattern, x, value = value, ...)
+ return(1:length(x) \%in\% indices)
+ }
+ grep(pattern, x, value = value, ...)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/incidence.matrix.Rd b/man/incidence.matrix.Rd
new file mode 100644
index 0000000..83f566d
--- /dev/null
+++ b/man/incidence.matrix.Rd
@@ -0,0 +1,57 @@
+\name{incidence.matrix}
+\alias{incidence.matrix}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Convert a factor into an incidence matrix
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+incidence.matrix(fact)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{fact}{
+%% ~~Describe \code{fact} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (fact)
+{
+ diag(nlevels(fact))[fact, ]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/interpolate.Rd b/man/interpolate.Rd
new file mode 100644
index 0000000..ac60c29
--- /dev/null
+++ b/man/interpolate.Rd
@@ -0,0 +1,86 @@
+\name{interpolate}
+\alias{interpolate}
+\title{Linear interpolation of numbers
+}
+\description{Wrapper for \code{approx()} that linearly projects missing data at the front and back. project determines how many terminal non-missing points are used to calculate a a projection slope.
+}
+\usage{
+interpolate(x, y, xout, project = 1, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{y}{
+%% ~~Describe \code{y} here~~
+}
+ \item{xout}{
+%% ~~Describe \code{xout} here~~
+}
+ \item{project}{
+%% ~~Describe \code{project} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, y, xout, project = 1, ...)
+{
+ yout <- approx(x, y, xout = xout, ...)$y
+ na <- is.na(yout)
+ if (0 < project & any(na)) {
+ known <- which(!na)
+ if (na[1]) {
+ k <- known[1]
+ front <- 1:(k - 1)
+ loc <- yout[k]
+ slope <- (yout[k + project] - loc)/project
+ yout[front] <- loc + (front - k) * slope
+ }
+ if (tail(na, 1)) {
+ k <- tail(known, 1)
+ back <- length(yout):k
+ loc <- yout[k]
+ slope <- (loc - yout[k - project])/project
+ yout[back] <- loc + (back - k) * slope
+ }
+ }
+ list(x = xout, y = yout)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/interpolate.Sys.env.Rd b/man/interpolate.Sys.env.Rd
new file mode 100644
index 0000000..7a8ed1a
--- /dev/null
+++ b/man/interpolate.Sys.env.Rd
@@ -0,0 +1,51 @@
+\name{interpolate.Sys.env}
+\alias{interpolate.Sys.env}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Substitute shell variables for their values in character strings.
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+interpolate.Sys.env(x, stop.on.fail = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{stop.on.fail}{
+%% ~~Describe \code{stop.on.fail} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/invlogit.Rd b/man/invlogit.Rd
new file mode 100644
index 0000000..ac70bb4
--- /dev/null
+++ b/man/invlogit.Rd
@@ -0,0 +1,57 @@
+\name{invlogit}
+\alias{invlogit}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Apply the inverse logit transformation
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+invlogit(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ exp(x)/(1 + exp(x))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/is.formula.Rd b/man/is.formula.Rd
new file mode 100644
index 0000000..5402835
--- /dev/null
+++ b/man/is.formula.Rd
@@ -0,0 +1,35 @@
+\name{is.formula}
+\alias{is.formula}
+\title{Tests for objects of type \code{formula}.
+}
+\description{
+Provides a test of whether an object inherits from class \code{formula}.
+}
+\usage{
+is.formula(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+ Object to be tested.
+}
+}
+\details{
+ A wrapper for \code{inherits(x, "formula")}.
+}
+\value{
+ A logical scalar equal to TRUE if x inherits from \code{formula} and FALSE otherwise.
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\seealso{
+ \code{as.integer}
+}
+\examples{
+ is.formula(y ~ a + bx)
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/is.informative.predictor.Rd b/man/is.informative.predictor.Rd
new file mode 100644
index 0000000..121f5bd
--- /dev/null
+++ b/man/is.informative.predictor.Rd
@@ -0,0 +1,67 @@
+\name{is.informative.predictor}
+\alias{is.informative.predictor}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{is.informative.predictor
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+is.informative.predictor(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ x <- as.data.frame(x)
+ ok <- complete.cases(x)
+ if (!all(ok))
+ x <- as.data.frame(x[ok, ])
+ for (i in 1:ncol(x)) {
+ if (1 < length(unique(x[, i]))) {
+ return(T)
+ }
+ }
+ return(1 < length(unique(x)))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/is.nullOrEmpty.Rd b/man/is.nullOrEmpty.Rd
new file mode 100644
index 0000000..9605660
--- /dev/null
+++ b/man/is.nullOrEmpty.Rd
@@ -0,0 +1,65 @@
+\name{is.nullOrEmpty}
+\alias{is.nullOrEmpty}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{is.nullOrEmpty
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+is.nullOrEmpty(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ if (is.null(x)) {
+ return(TRUE)
+ }
+ if (0 == length(x))
+ return(TRUE)
+ if (0 == prod(dim(x)))
+ return(TRUE)
+ FALSE
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/is.wholenumber.Rd b/man/is.wholenumber.Rd
new file mode 100644
index 0000000..90ec28e
--- /dev/null
+++ b/man/is.wholenumber.Rd
@@ -0,0 +1,60 @@
+\name{is.wholenumber}
+\alias{is.wholenumber}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Tests for whole numbers
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+is.wholenumber(x, tol = .Machine$double.eps^0.5)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{tol}{
+%% ~~Describe \code{tol} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, tol = .Machine$double.eps^0.5)
+{
+ abs(x - round(x)) < tol
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/list.has.Rd b/man/list.has.Rd
new file mode 100644
index 0000000..da36311
--- /dev/null
+++ b/man/list.has.Rd
@@ -0,0 +1,64 @@
+\name{list.has}
+\alias{list.has}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{list.has
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+list.has(x, key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, key)
+{
+ if (is.numeric(key)) {
+ return(key <= length(x))
+ }
+ key \%in\% names(x)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/list.subdirs.Rd b/man/list.subdirs.Rd
new file mode 100644
index 0000000..26e66e1
--- /dev/null
+++ b/man/list.subdirs.Rd
@@ -0,0 +1,65 @@
+\name{list.subdirs}
+\alias{list.subdirs}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{List the subdirectories in a Directory/Folder
+}
+\description{
+A wrapper for the standard utility function \code{list.files} that returns only the names of subdirectories (ie, excludes files, and other non-directory items).
+}
+\usage{
+list.subdirs(path = ".", ..., full.names = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{path}{
+%% ~~Describe \code{path} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+ \item{full.names}{
+%% ~~Describe \code{full.names} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (path = ".", ..., full.names = FALSE)
+{
+ path.names <- list.files(path, ..., full.names = TRUE)
+ files <- list.files(path, ..., full.names = full.names)
+ files[file.info(path.names)$isdir]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/lm.multiresponse.Rd b/man/lm.multiresponse.Rd
new file mode 100644
index 0000000..f4a4ab6
--- /dev/null
+++ b/man/lm.multiresponse.Rd
@@ -0,0 +1,168 @@
+\name{lm.multiresponse}
+\alias{lm.multiresponse}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{lm.multiresponse
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+lm.multiresponse(formula, response.matrix, data, null.formula = NULL, null.fit = NULL, rsquared = FALSE, pvalue = FALSE, logP = FALSE, LOD = FALSE, model.args = list(), verbose.at.every = 0)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{formula}{
+%% ~~Describe \code{formula} here~~
+}
+ \item{response.matrix}{
+%% ~~Describe \code{response.matrix} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{null.fit}{
+%% ~~Describe \code{null.fit} here~~
+}
+ \item{rsquared}{
+%% ~~Describe \code{rsquared} here~~
+}
+ \item{pvalue}{
+%% ~~Describe \code{pvalue} here~~
+}
+ \item{logP}{
+%% ~~Describe \code{logP} here~~
+}
+ \item{LOD}{
+%% ~~Describe \code{LOD} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+ \item{verbose.at.every}{
+%% ~~Describe \code{verbose.at.every} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (formula, response.matrix, data, null.formula = NULL,
+ null.fit = NULL, rsquared = FALSE, pvalue = FALSE, logP = FALSE,
+ LOD = FALSE, model.args = list(), verbose.at.every = 0)
+{
+ formula <- as.formula(formula)
+ response.matrix <- as.matrix(response.matrix)
+ terms.object <- terms(formula)
+ if (0 == attr(terms.object, "response")) {
+ stop("Must specify response in formula\n")
+ }
+ if (1 != attr(terms.object, "response") | length(all.vars(terms.object)) !=
+ nrow(attr(terms.object, "factors"))) {
+ stop("Multivariate response not allowed\n")
+ }
+ response.name <- all.vars(terms.object)[1]
+ response.expr <- rownames(attr(terms.object, "factors"))[1]
+ if (response.name != response.expr) {
+ FUN2 <- eval(parse(text = paste("FUN <- function(", response.name,
+ "){", response.expr, "}", sep = "")))
+ response.matrix <- apply(response.matrix, 2, FUN2)
+ }
+ if (!all(is.finite(response.matrix))) {
+ stop("Response must be finite\n")
+ }
+ data[, response.name] <- response.matrix[, 1]
+ fit <- do.call("lm", args = c(model.args, list(formula = as.formula(formula),
+ data = quote(data))))
+ qr <- fit$qr
+ tss <- numeric(ncol(response.matrix))
+ rss <- numeric(ncol(response.matrix))
+ for (i in 1:ncol(response.matrix)) {
+ if (0 != verbose.at.every) {
+ if (0 == i\%\%verbose.at.every) {
+ cat(i, "/", ncol(response.matrix), "\n")
+ }
+ }
+ y <- response.matrix[, i]
+ tss[i] <- SS(y)
+ rss[i] <- sum(qr.resid(qr, y)^2)
+ }
+ retval <- list(n = length(resid(fit)), tss = tss, rss = rss,
+ rank = fit$rank, df.residual = fit$df.residual)
+ if (rsquared)
+ retval$rsquared <- (tss - rss)/tss
+ if (!is.null(null.fit) | !is.null(null.formula)) {
+ if (is.null(null.formula)) {
+ formula.as.string(null.fit$terms)
+ }
+ if (split.formula(null.formula)$response != split.formula(null.formula)$response) {
+ stop("Response expression in formula and null formula differ: ",
+ split.formula(null.formula)$response, " vs ",
+ split.formula(formula)$response, "\n")
+ }
+ if (is.null(null.fit)) {
+ null.fit <- do.call("lm", args = c(model.args, list(formula = as.formula(null.formula),
+ data = quote(data))))
+ }
+ qr0 <- null.fit$qr
+ rss0 <- numeric(ncol(response.matrix))
+ for (i in 1:ncol(response.matrix)) {
+ y <- response.matrix[, i]
+ rss0[i] <- sum(qr.resid(qr0, y)^2)
+ }
+ retval$null.rss <- rss0
+ retval$null.rank <- null.fit$rank
+ if (pvalue | logP) {
+ dfr <- fit$df.residual
+ delta.dfp <- fit$rank - null.fit$rank
+ fss <- rss0 - rss
+ f <- fss/rss * dfr/delta.dfp
+ if (pvalue | logP) {
+ pval <- pf(f, delta.dfp, dfr, lower.tail = F)
+ if (pvalue)
+ retval$pvalue <- pval
+ if (logP)
+ retval$logP <- -log10(pval)
+ }
+ }
+ if (LOD) {
+ retval$LOD <- (retval$n/2) * (log10(rss0) - log10(rss))
+ }
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/lm.multiscan.Rd b/man/lm.multiscan.Rd
new file mode 100644
index 0000000..5c59ecd
--- /dev/null
+++ b/man/lm.multiscan.Rd
@@ -0,0 +1,107 @@
+\name{lm.multiscan}
+\alias{lm.multiscan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{lm.multiscan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+lm.multiscan(h, response.matrix, markers, null.formula, test.formula, data, scan.function.args = list(), verbose = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{response.matrix}{
+%% ~~Describe \code{response.matrix} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{test.formula}{
+%% ~~Describe \code{test.formula} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{scan.function.args}{
+%% ~~Describe \code{scan.function.args} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, response.matrix, markers, null.formula, test.formula,
+ data, scan.function.args = list(), verbose = TRUE)
+{
+ model.args0 <- c(scan.function.args, list(formula = as.formula(null.formula),
+ data = quote(data), x = TRUE, y = TRUE, qr = TRUE))
+ fit0 <- do.call("lm", args = model.args0)
+ num.loci <- length(markers)
+ num.responses <- ncol(response.matrix)
+ scores.LOD <- matrix(nrow = num.loci, ncol = num.responses)
+ scores.modelcmp <- matrix(nrow = num.loci, ncol = num.responses)
+ if (verbose)
+ cat("scanning multiple phenotypes for marker ")
+ for (m in 1:num.loci) {
+ if (verbose)
+ cat("[", m, "]", sep = "")
+ marker <- markers[m]
+ expanded <- happy.expand.formula(h, formulae = c(null.formula,
+ test.formula), subjects = data$SUBJECT.NAME, THE.LOCUS = marker)
+ marker.results <- lm.multiresponse(formula = expanded$formulae[2],
+ response.matrix = response.matrix, data = cbind(data,
+ expanded$locus.data), null.formula = expanded$formulae[1],
+ null.fit = fit0, logP = TRUE, LOD = TRUE, model.args = scan.function.args)
+ if (is.null(marker.results))
+ next
+ scores.modelcmp[m, ] <- marker.results$logP
+ scores.LOD[m, ] <- marker.results$LOD
+ }
+ if (verbose)
+ cat("\n")
+ list(modelcmp.type = "logP", response.number = 1:num.responses,
+ scores.modelcmp = scores.modelcmp, scores.LOD = scores.LOD)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/load.gscan.Rd b/man/load.gscan.Rd
new file mode 100644
index 0000000..f64d3e0
--- /dev/null
+++ b/man/load.gscan.Rd
@@ -0,0 +1,94 @@
+\name{load.gscan}
+\alias{load.gscan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{load.gscan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+load.gscan(files = NULL, pattern = NULL, dir = "./HAPPY/BOTH/", verbose = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{files}{
+%% ~~Describe \code{files} here~~
+}
+ \item{pattern}{
+%% ~~Describe \code{pattern} here~~
+}
+ \item{dir}{
+%% ~~Describe \code{dir} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (files = NULL, pattern = NULL, dir = "./HAPPY/BOTH/",
+ verbose = TRUE)
+{
+ if (is.nullOrEmpty(files)) {
+ files <- grep(pattern, value = TRUE, list.files(dir))
+ if (0 == length(files)) {
+ stop("Could not find files matching pattern ", pattern,
+ " in directory ", dir, "\n")
+ }
+ files <- paste(sep = "/", dir, files)
+ }
+ if (verbose)
+ cat("Loading scan files\n", paste(files, collapse = "\n"),
+ "\n")
+ retval <- list(phenotype = NULL, genome = NULL, chromosomes = list())
+ for (file in files) {
+ c.scan <- read.scan.file(file)
+ c.name <- c.scan$chromosome
+ retval$chromosomes[[c.name]] <- c.scan$scan.data
+ if (is.null(retval$phenotype)) {
+ retval$phenotype <- c.scan$phenotype
+ }
+ else if (retval$phenotype != c.scan$phenotype) {
+ stop("Scan files must contain the same phenotype. Files:\n",
+ paste("\t", collapse = "\n", files), "\nphenotypes:\n",
+ retval$phenotype, "\n", c.scan$phenotype, "\n")
+ }
+ retval$genome <- rbind(retval$genome, c.scan$scan.data)
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/logit.Rd b/man/logit.Rd
new file mode 100644
index 0000000..ec3b677
--- /dev/null
+++ b/man/logit.Rd
@@ -0,0 +1,57 @@
+\name{logit}
+\alias{logit}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Apply the logit transformation
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+logit(p)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{p}{
+%% ~~Describe \code{p} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (p)
+{
+ log(p/(1 - p))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.parboot.permutation.matrix.Rd b/man/make.parboot.permutation.matrix.Rd
new file mode 100644
index 0000000..3898c42
--- /dev/null
+++ b/man/make.parboot.permutation.matrix.Rd
@@ -0,0 +1,95 @@
+\name{make.parboot.permutation.matrix}
+\alias{make.parboot.permutation.matrix}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.parboot.permutation.matrix
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.parboot.permutation.matrix(null.formula, num.responses, data, seed, model.type, model.args)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{num.responses}{
+%% ~~Describe \code{num.responses} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{seed}{
+%% ~~Describe \code{seed} here~~
+}
+ \item{model.type}{
+%% ~~Describe \code{model.type} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (null.formula, num.responses, data, seed, model.type,
+ model.args)
+{
+ set.seed(seed)
+ response.vars = split.formula(null.formula)$response.vars
+ if (1 != length(response.vars)) {
+ stop("Can currently handle only univariate nullsimperms\n")
+ }
+ y = data[, response.vars]
+ fake.response.name = "FAKE.Z"
+ perm.matrix = matrix(nrow = length(y), ncol = num.responses)
+ for (i in 1:num.responses) {
+ r = rank(y, ties = "random")
+ rank2yindex = order(r)
+ z = r
+ data[, fake.response.name] = z
+ zform = paste(fake.response.name, "~", split.formula(null.formula)$predictors)
+ fit = unify.fit(zform, data = data, model.type = model.type,
+ args = model.args)
+ zstar = as.numeric(unify.simulate(fit))
+ rstar = rank(zstar, ties = "random")
+ yistar = rank2yindex[rstar]
+ perm.matrix[, i] = yistar
+ }
+ perm.matrix
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.parboot.permuted.responses.Rd b/man/make.parboot.permuted.responses.Rd
new file mode 100644
index 0000000..f8b7374
--- /dev/null
+++ b/man/make.parboot.permuted.responses.Rd
@@ -0,0 +1,82 @@
+\name{make.parboot.permuted.responses}
+\alias{make.parboot.permuted.responses}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.parboot.permuted.responses
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.parboot.permuted.responses(h, null.formula, num.responses, data, seed, model.type, model.args)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{num.responses}{
+%% ~~Describe \code{num.responses} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{seed}{
+%% ~~Describe \code{seed} here~~
+}
+ \item{model.type}{
+%% ~~Describe \code{model.type} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, null.formula, num.responses, data, seed, model.type,
+ model.args)
+{
+ perm.matrix <- make.parboot.permutation.matrix(null.formula,
+ num.responses, data = data, seed = seed, model.type = model.type,
+ model.args = model.args)
+ response.vars <- split.formula(null.formula)$response.vars
+ original.response <- data[, response.vars]
+ apply.permutation.matrix(original.response, perm.matrix)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.parboot.responses.Rd b/man/make.parboot.responses.Rd
new file mode 100644
index 0000000..cc257b9
--- /dev/null
+++ b/man/make.parboot.responses.Rd
@@ -0,0 +1,88 @@
+\name{make.parboot.responses}
+\alias{make.parboot.responses}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.parboot.responses
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.parboot.responses(h, null.formula, num.responses, data, seed, model.type, model.args)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{num.responses}{
+%% ~~Describe \code{num.responses} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{seed}{
+%% ~~Describe \code{seed} here~~
+}
+ \item{model.type}{
+%% ~~Describe \code{model.type} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, null.formula, num.responses, data, seed, model.type,
+ model.args)
+{
+ set.seed(seed)
+ response.vars = split.formula(null.formula)$response.vars
+ if (1 != length(response.vars)) {
+ stop("Can currently handle only univariate nullsims\n")
+ }
+ fit = unify.fit(null.formula, data = data, model.type = model.type,
+ args = model.args)
+ response.list = list()
+ for (i in 1:num.responses) {
+ response.list[[i]] = unify.simulate(fit)
+ }
+ response.list
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.permuted.responses.Rd b/man/make.permuted.responses.Rd
new file mode 100644
index 0000000..79dc289
--- /dev/null
+++ b/man/make.permuted.responses.Rd
@@ -0,0 +1,74 @@
+\name{make.permuted.responses}
+\alias{make.permuted.responses}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.permuted.responses
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.permuted.responses(h, null.formula, num.perms, data, seed)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{num.perms}{
+%% ~~Describe \code{num.perms} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{seed}{
+%% ~~Describe \code{seed} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, null.formula, num.perms, data, seed)
+{
+ perm.matrix <- permutation.matrix(num.perms = num.perms,
+ data = data, seed = seed)
+ response.vars <- split.formula(null.formula)$response.vars
+ original.response <- data[, response.vars]
+ apply.permutation.matrix(original.response, perm.matrix)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.posboot.summary.Rd b/man/make.posboot.summary.Rd
new file mode 100644
index 0000000..24e8328
--- /dev/null
+++ b/man/make.posboot.summary.Rd
@@ -0,0 +1,79 @@
+\name{make.posboot.summary}
+\alias{make.posboot.summary}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.posboot.summary
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.posboot.summary(h, loci, boot.results)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{loci}{
+%% ~~Describe \code{loci} here~~
+}
+ \item{boot.results}{
+%% ~~Describe \code{boot.results} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, loci, boot.results)
+{
+ boot.summary = data.frame(loci = loci, chr = happy.get.chromosome(h,
+ loci), cM.start = happy.get.interval.range(h, loci, scale = "cM")[,
+ 1], cM.end = happy.get.interval.range(h, loci, scale = "cM")[,
+ 2], Mb.start = happy.get.interval.range(h, loci, scale = "Mb")[,
+ 1], Mb.end = happy.get.interval.range(h, loci, scale = "Mb")[,
+ 2], times.max.LOD = rep(0, length(loci)), times.max.modelcmp = rep(0,
+ length(loci)))
+ lods = as.matrix(boot.results[, 1:length(loci)])
+ lods.max = table(apply(lods, 1, which.max))
+ boot.summary$times.max.LOD[as.integer(names(lods.max))] = lods.max
+ boot.summary$cumfrac.max.LOD = cumsum(boot.summary$times.max.LOD)/num.boots
+ cmps = as.matrix(boot.results[, -c(1:length(loci))])
+ cmps.max = table(apply(cmps, 1, which.max))
+ boot.summary$times.max.modelcmp[as.integer(names(cmps.max))] = cmps.max
+ boot.summary$cumfrac.max.modelcmp = cumsum(boot.summary$times.max.modelcmp)/num.boots
+ boot.summary
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.posboot.summary.ci.Rd b/man/make.posboot.summary.ci.Rd
new file mode 100644
index 0000000..e73b91f
--- /dev/null
+++ b/man/make.posboot.summary.ci.Rd
@@ -0,0 +1,69 @@
+\name{make.posboot.summary.ci}
+\alias{make.posboot.summary.ci}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.posboot.summary.ci
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.posboot.summary.ci(boot.summary, prob = 0.95, score = "LOD")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{boot.summary}{
+%% ~~Describe \code{boot.summary} here~~
+}
+ \item{prob}{
+%% ~~Describe \code{prob} here~~
+}
+ \item{score}{
+%% ~~Describe \code{score} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (boot.summary, prob = 0.95, score = "LOD")
+{
+ score.col = paste("times.max.", sep = "", score)
+ ci = which.wide.ci(boot.summary[, score.col], prob = prob)
+ data.frame(score = score, ci = prob, idx.start = ci[1], idx.end = ci[2],
+ locus.start = boot.summary$locus[ci[1]], locus.end = boot.summary$locus[ci[2]],
+ cM.start = boot.summary$cM.start[ci[1]], cM.end = boot.summary$cM.end[ci[2]],
+ Mb.start = boot.summary$Mb.start[ci[1]], Mb.end = boot.summary$Mb.end[ci[2]])
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.reduce.dmat.fun.Rd b/man/make.reduce.dmat.fun.Rd
new file mode 100644
index 0000000..d359457
--- /dev/null
+++ b/man/make.reduce.dmat.fun.Rd
@@ -0,0 +1,74 @@
+\name{make.reduce.dmat.fun}
+\alias{make.reduce.dmat.fun}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.reduce.dmat.fun
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.reduce.dmat.fun(config.string)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config.string}{
+%% ~~Describe \code{config.string} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config.string)
+{
+ if ("FALSE" == config.string) {
+ return(NULL)
+ }
+ cutoff <- NULL
+ if ("TRUE" == config.string) {
+ cutoff <- DEFAULT.REDUCE.DMAT.CUTOFF
+ }
+ else {
+ cutoff <- try(as.numeric(config.string))
+ if (caught.error(cutoff)) {
+ bagpipe.input.error("reduce.dmat option must be TRUE, FALSE or a real positive number\n")
+ }
+ cutoff <- abs(cutoff)
+ }
+ return(function(x) {
+ reduce.dim(x, sdev.cutoff = cutoff)
+ })
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/make.step.data.Rd b/man/make.step.data.Rd
new file mode 100644
index 0000000..c5869b6
--- /dev/null
+++ b/man/make.step.data.Rd
@@ -0,0 +1,78 @@
+\name{make.step.data}
+\alias{make.step.data}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{make.step.data
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+make.step.data(x, y, last.x = NULL, jitter.factor = 10000)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{y}{
+%% ~~Describe \code{y} here~~
+}
+ \item{last.x}{
+%% ~~Describe \code{last.x} here~~
+}
+ \item{jitter.factor}{
+%% ~~Describe \code{jitter.factor} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, y, last.x = NULL, jitter.factor = 10000)
+{
+ d <- x[2:length(x)] - x[1:(length(x) - 1)]
+ tiny <- min(d, na.rm = TRUE)/jitter.factor
+ new.x <- rep(NA, 2 * length(x) - 1)
+ new.x[2 * (1:length(x)) - 1] <- x
+ new.x[2 * (1:(length(x) - 1))] <- x[-length(x)] + d - tiny
+ new.y <- as.numeric(y \%x\% c(1, 1))
+ new.y <- new.y[-length(new.y)]
+ if (!is.null(last.x)) {
+ new.x <- c(new.x, last.x)
+ new.y <- c(new.y, new.y[length(new.y)])
+ }
+ data.frame(x = new.x, y = new.y)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/map.eq.Rd b/man/map.eq.Rd
new file mode 100644
index 0000000..c06f9b2
--- /dev/null
+++ b/man/map.eq.Rd
@@ -0,0 +1,79 @@
+\name{map.eq}
+\alias{map.eq}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Substitute all elements using a look-up table
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+map.eq(x, lookup = NULL, from = NULL, to = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{lookup}{
+%% ~~Describe \code{lookup} here~~
+}
+ \item{from}{
+%% ~~Describe \code{from} here~~
+}
+ \item{to}{
+%% ~~Describe \code{to} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, lookup = NULL, from = NULL, to = NULL)
+{
+ y <- x
+ if (!is.null(from) & !is.null(to)) {
+ if (length(from) != length(to)) {
+ stop("Arguments $from and $to must be the same length\n")
+ }
+ for (k in 1:length(from)) {
+ i <- x == from[k]
+ y[i] <- to[k]
+ }
+ }
+ if (!is.null(lookup)) {
+ y <- map.eq(y, from = names(lookup), to = unlist(lookup))
+ }
+ return(y)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/mdlist.get.Rd b/man/mdlist.get.Rd
new file mode 100644
index 0000000..5af41fc
--- /dev/null
+++ b/man/mdlist.get.Rd
@@ -0,0 +1,67 @@
+\name{mdlist.get}
+\alias{mdlist.get}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{mdlist.get
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+mdlist.get(obj, key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{obj}{
+%% ~~Describe \code{obj} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (obj, key)
+{
+ if (0 == length(key)) {
+ stop("Argument 'key' must have at least one element\n")
+ }
+ if (1 == length(key)) {
+ return(obj[[key, exact = TRUE]])
+ }
+ mdlist.get(obj[[key[1], exact = TRUE]], key[-1])
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/mdlist.has.Rd b/man/mdlist.has.Rd
new file mode 100644
index 0000000..b52057d
--- /dev/null
+++ b/man/mdlist.has.Rd
@@ -0,0 +1,78 @@
+\name{mdlist.has}
+\alias{mdlist.has}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{mdlist.has
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+mdlist.has(obj, key)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{obj}{
+%% ~~Describe \code{obj} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (obj, key)
+{
+ list.has <- function(x, key) {
+ if (is.numeric(key)) {
+ return(key <= length(x))
+ }
+ key \%in\% names(x)
+ }
+ if (0 == length(key)) {
+ stop("Argument 'key' must have at least one element\n")
+ }
+ if (1 == length(key)) {
+ return(list.has(obj, key))
+ }
+ if (1 < length(key)) {
+ if (!list.has(obj, key[1])) {
+ return(FALSE)
+ }
+ return(mdlist.has(obj[[key[1]]], key[-1]))
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/mdlist.put.Rd b/man/mdlist.put.Rd
new file mode 100644
index 0000000..43fe8e1
--- /dev/null
+++ b/man/mdlist.put.Rd
@@ -0,0 +1,78 @@
+\name{mdlist.put}
+\alias{mdlist.put}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{mdlist.put
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+mdlist.put(obj, key, value)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{obj}{
+%% ~~Describe \code{obj} here~~
+}
+ \item{key}{
+%% ~~Describe \code{key} here~~
+}
+ \item{value}{
+%% ~~Describe \code{value} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (obj, key, value)
+{
+ num.keys <- length(key)
+ if (0 == num.keys) {
+ stop("Argument 'key' must have at least one element\n")
+ }
+ if (1 == num.keys) {
+ obj[[key]] <- value
+ return(obj)
+ }
+ if (1 < num.keys) {
+ if (!mdlist.has(obj, key[1])) {
+ obj[[key[1]]] <- list()
+ }
+ obj[[key[1]]] <- mdlist.put(obj[[key[1]]], key[-1], value)
+ }
+ obj
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/new.hash.Rd b/man/new.hash.Rd
new file mode 100644
index 0000000..8a767d6
--- /dev/null
+++ b/man/new.hash.Rd
@@ -0,0 +1,53 @@
+\name{new.hash}
+\alias{new.hash}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{new.hash
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+new.hash()
+}
+%- maybe also 'usage' for other objects documented here.
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function ()
+{
+ new.env(hash = TRUE)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/object.sizes.Rd b/man/object.sizes.Rd
new file mode 100644
index 0000000..b229517
--- /dev/null
+++ b/man/object.sizes.Rd
@@ -0,0 +1,76 @@
+\name{object.sizes}
+\alias{object.sizes}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{User-friendly listing of memory consumption by all objects
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+object.sizes(env = parent.frame(), sort = "sd", format = "Mb")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{env}{
+%% ~~Describe \code{env} here~~
+}
+ \item{sort}{
+%% ~~Describe \code{sort} here~~
+}
+ \item{format}{
+%% ~~Describe \code{format} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (env = parent.frame(), sort = "sd", format = "Mb")
+{
+ obs <- objects(name = env)
+ sizes <- numeric(length(obs))
+ for (i in 1:length(obs)) {
+ sizes[i] <- eval(parse(text = paste("object.size(", obs[i],
+ ")")), env = env)
+ }
+ names(sizes) <- obs
+ if ("sd" == sort) {
+ sizes <- sizes[order(-sizes)]
+ }
+ if ("Mb" == format) {
+ sizes <- round(sizes/2^20, 3)
+ }
+ sizes
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/permutation.matrix.Rd b/man/permutation.matrix.Rd
new file mode 100644
index 0000000..2253add
--- /dev/null
+++ b/man/permutation.matrix.Rd
@@ -0,0 +1,97 @@
+\name{permutation.matrix}
+\alias{permutation.matrix}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{permutation.matrix
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+permutation.matrix(num.perms, data, column = NULL, seed = NULL, rows = 1:nrow(data))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{num.perms}{
+%% ~~Describe \code{num.perms} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{column}{
+%% ~~Describe \code{column} here~~
+}
+ \item{seed}{
+%% ~~Describe \code{seed} here~~
+}
+ \item{rows}{
+%% ~~Describe \code{rows} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (num.perms, data, column = NULL, seed = NULL, rows = 1:nrow(data))
+{
+ if (!is.null(seed))
+ set.seed(seed)
+ if (!is.null(column) & num.perms > 0) {
+ mat <- matrix(nrow = nrow(data), ncol = num.perms)
+ id <- c(1:nrow(data))
+ sp <- split(id, as.factor(column))
+ for (j in 1:num.perms) {
+ mat[, j] <- id
+ for (f in names(sp)) {
+ if (length(sp[[f]]) > 1) {
+ mat[sp[[f]], j] <- sample(sp[[f]], replace = F)
+ }
+ }
+ }
+ return(mat)
+ }
+ else if (num.perms > 0) {
+ cat("permuting randomly with no cols\n")
+ mat <- matrix(nrow = nrow(data), ncol = num.perms)
+ id <- 1:nrow(data)
+ permutable <- id \%in\% rows
+ for (j in 1:num.perms) {
+ mat[permutable, j] <- sample(rows, replace = F)
+ mat[!permutable, j] <- id[!permutable]
+ }
+ return(mat)
+ }
+ return(NULL)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/polygonh.Rd b/man/polygonh.Rd
new file mode 100644
index 0000000..6f80b01
--- /dev/null
+++ b/man/polygonh.Rd
@@ -0,0 +1,68 @@
+\name{polygonh}
+\alias{polygonh}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{polygonh
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+polygonh(xrange, ypos, yheight, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{xrange}{
+%% ~~Describe \code{xrange} here~~
+}
+ \item{ypos}{
+%% ~~Describe \code{ypos} here~~
+}
+ \item{yheight}{
+%% ~~Describe \code{yheight} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (xrange, ypos, yheight, ...)
+{
+ polygon(xrange[c(1, 1, 2, 2)], c(ypos, rep(ypos + yheight,
+ 2), ypos), ...)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/pop.back.Rd b/man/pop.back.Rd
new file mode 100644
index 0000000..ae490a1
--- /dev/null
+++ b/man/pop.back.Rd
@@ -0,0 +1,60 @@
+\name{pop.back}
+\alias{pop.back}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{pop.back
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+pop.back(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ r <- x[length(x)]
+ eval.parent(substitute(x <- x[-length(x)]))
+ return(r)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/pop.front.Rd b/man/pop.front.Rd
new file mode 100644
index 0000000..da226d3
--- /dev/null
+++ b/man/pop.front.Rd
@@ -0,0 +1,60 @@
+\name{pop.front}
+\alias{pop.front}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{pop.front
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+pop.front(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ r <- x[1]
+ eval.parent(substitute(x <- x[-1]))
+ return(r)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/push.back.Rd b/man/push.back.Rd
new file mode 100644
index 0000000..18546a9
--- /dev/null
+++ b/man/push.back.Rd
@@ -0,0 +1,67 @@
+\name{push.back}
+\alias{push.back}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{push.back
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+push.back(x, y)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{y}{
+%% ~~Describe \code{y} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, y)
+{
+ if (is.list(x)) {
+ eval.parent(substitute(x[[(length(x) + 1)]] <- y))
+ }
+ else {
+ eval.parent(substitute(x[(length(x) + 1):(length(x) +
+ length(y))] <- y))
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/push.front.Rd b/man/push.front.Rd
new file mode 100644
index 0000000..35f3903
--- /dev/null
+++ b/man/push.front.Rd
@@ -0,0 +1,64 @@
+\name{push.front}
+\alias{push.front}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{push.front
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+push.front(x, y)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{y}{
+%% ~~Describe \code{y} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, y)
+{
+ if (is.list(x)) {
+ stop("push.front() for list not yet implemented\n")
+ }
+ eval.parent(substitute(x <- c(y, x)))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/read.configfile.Rd b/man/read.configfile.Rd
new file mode 100644
index 0000000..6e648ed
--- /dev/null
+++ b/man/read.configfile.Rd
@@ -0,0 +1,67 @@
+\name{read.configfile}
+\alias{read.configfile}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Read a configuration file into a data structure
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+read.configfile(file)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{file}{
+%% ~~Describe \code{file} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (file)
+{
+ line.list <- scan(file = file, sep = "\n", strip.white = TRUE,
+ what = character(0))
+ line.vect <- as.character(line.list)
+ config <- list()
+ for (line in line.vect) {
+ x <- strsplit(line, split = "[[:space:]]+")[[1]]
+ key <- pop.front(x)
+ value <- paste(x, collapse = " ")
+ config <- mdlist.put(config, key, value)
+ }
+ return(config)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/read.scan.file.Rd b/man/read.scan.file.Rd
new file mode 100644
index 0000000..bc234cc
--- /dev/null
+++ b/man/read.scan.file.Rd
@@ -0,0 +1,83 @@
+\name{read.scan.file}
+\alias{read.scan.file}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{read.scan.file
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+read.scan.file(file)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{file}{
+%% ~~Describe \code{file} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (file)
+{
+ text <- readLines(file)
+ start <- grep("^BEGIN_SCAN_DATA", text) + 1
+ end <- grep("^END_SCAN_DATA", text) - 1
+ if (length(start) != 1 | length(end) != 1) {
+ stop("Cannot read scan file", file, "\n")
+ }
+ textCon <- textConnection(text[start:end])
+ scan.data <- cols.as(read.delim(textCon), list(locus = "character",
+ chr = "character"))
+ close(textCon)
+ out <- list(scan.data = scan.data)
+ start <- grep("^BEGIN_ANOVA", text) + 1
+ end <- grep("^END_ANOVA", text) - 1
+ if ((length(start) == 1 | length(end) == 1) & force.logical(end -
+ start)) {
+ textCon <- textConnection(text[start:end])
+ out$anova <- try(read.delim(textCon))
+ close(textCon)
+ }
+ wanted <- c("phenotype", "build", "chromosome", "formula")
+ for (w in wanted) {
+ pattern <- paste("^", toupper(w), sep = "")
+ out[[w]] <- string.trim(sub(pattern, "", grep(pattern,
+ text, value = T)))
+ }
+ out
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/reduce.dim.Rd b/man/reduce.dim.Rd
new file mode 100644
index 0000000..317c784
--- /dev/null
+++ b/man/reduce.dim.Rd
@@ -0,0 +1,72 @@
+\name{reduce.dim}
+\alias{reduce.dim}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{reduce.dim
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+reduce.dim(x, sdev.cutoff = 0.01, cor = FALSE, scale = TRUE, center = TRUE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{sdev.cutoff}{
+%% ~~Describe \code{sdev.cutoff} here~~
+}
+ \item{cor}{
+%% ~~Describe \code{cor} here~~
+}
+ \item{scale}{
+%% ~~Describe \code{scale} here~~
+}
+ \item{center}{
+%% ~~Describe \code{center} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, sdev.cutoff = 0.01, cor = FALSE, scale = TRUE, center = TRUE)
+{
+ x <- as.matrix(x)
+ prc <- prcomp(x, cor = cor, scale = scale, center = center)
+ return(x \%*\% prc$rotation[, which(prc$sdev > sdev.cutoff)])
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/scan.phenotype.Rd b/man/scan.phenotype.Rd
new file mode 100644
index 0000000..b2d0f83
--- /dev/null
+++ b/man/scan.phenotype.Rd
@@ -0,0 +1,119 @@
+\name{scan.phenotype}
+\alias{scan.phenotype}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{scan.phenotype
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+scan.phenotype(h, config, markers, scan.type, verbose = FALSE, seed = 1)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{h}{
+%% ~~Describe \code{h} here~~
+}
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{markers}{
+%% ~~Describe \code{markers} here~~
+}
+ \item{scan.type}{
+%% ~~Describe \code{scan.type} here~~
+}
+ \item{verbose}{
+%% ~~Describe \code{verbose} here~~
+}
+ \item{seed}{
+%% ~~Describe \code{seed} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (h, config, markers, scan.type, verbose = FALSE, seed = 1)
+{
+ pheno <- configfile.string(config, "analysis.id")
+ d <- get.phenotype.data(h, config = config, subjects = happy.get.subjects(h))
+ result <- NULL
+ if ("scan" == scan.type) {
+ result <- general.scan(h, data = d$pdata, markers = markers,
+ null.formula = d$scan.options$null.formula, test.formula = d$scan.options$test.formula,
+ reduce.dmat = d$scan.options$reduce.dmat, model.type = d$scan.options$fitting.family,
+ model.args = d$scan.options$fitting.args, verbose = verbose)
+ }
+ else if (scan.type \%in\% c("permute.scan", "nullsim.scan",
+ "nullsimpermute.scan")) {
+ num.nullscans <- configfile.integer(config, "num.nullscans")
+ nullscan.seed <- configfile.integer(config, "nullscan.seed")
+ fake.responses <- NULL
+ if ("permute.scan" == scan.type) {
+ fake.responses <- make.permuted.responses(h, null.formula = d$scan.options$null.formula,
+ num.perms = num.nullscans, data = d$pdata, seed = nullscan.seed)
+ }
+ else if ("nullsim.scan" == scan.type) {
+ fake.responses <- make.parboot.responses(h, null.formula = d$scan.options$null.formula,
+ num.responses = num.nullscans, data = d$pdata,
+ seed = nullscan.seed, model.type = d$scan.options$fitting.family,
+ model.args = d$scan.options$fitting.args)
+ }
+ else if ("nullsimpermute.scan" == scan.type) {
+ fake.responses <- make.parboot.permuted.responses(h,
+ null.formula = d$scan.options$null.formula, num.responses = num.nullscans,
+ data = d$pdata, seed = nullscan.seed, model.type = d$scan.options$fitting.family,
+ model.args = d$scan.options$fitting.args)
+ }
+ if ("gaussian" == d$scan.options$fitting.family & !unify.is.multilevel.formula(d$scan.options$null.formula) &
+ !unify.is.multilevel.formula(d$scan.options$test.formula)) {
+ fake.response.matrix <- sapply(fake.responses, function(x) x)
+ result <- lm.multiscan(h, response.matrix = fake.response.matrix,
+ data = d$pdata, markers = markers, null.formula = d$scan.options$null.formula,
+ test.formula = d$scan.options$test.formula, scan.function.args = d$scan.options$fitting.args,
+ verbose = TRUE)
+ }
+ else {
+ result <- general.multiscan(h, responses = fake.responses,
+ data = d$pdata, markers = markers, null.formula = d$scan.options$null.formula,
+ test.formula = d$scan.options$test.formula, scan.function.args = d$scan.options$fitting.args,
+ reduce.dmat = d$scan.options$reduce.dmat, model.type = d$scan.options$fitting.family,
+ model.args = d$scan.options$fitting.args, verbose = TRUE)
+ }
+ }
+ result
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/se.mean.Rd b/man/se.mean.Rd
new file mode 100644
index 0000000..01e7e38
--- /dev/null
+++ b/man/se.mean.Rd
@@ -0,0 +1,63 @@
+\name{se.mean}
+\alias{se.mean}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Standard error of the mean
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+se.mean(x, na.rm = FALSE)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+ \item{na.rm}{
+%% ~~Describe \code{na.rm} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x, na.rm = FALSE)
+{
+ n <- sum(!is.na(x))
+ if (n < 2)
+ return(NaN)
+ sd(x, na.rm = na.rm)/sqrt(n)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/split.formula.Rd b/man/split.formula.Rd
new file mode 100644
index 0000000..3fea092
--- /dev/null
+++ b/man/split.formula.Rd
@@ -0,0 +1,42 @@
+\name{split.formula}
+\alias{split.formula}
+\title{Split a formula into its component parts.
+}
+\description{
+ This function uses the \code{terms()} function and other related constructs to split a formula into its component parts. Given a formula object or a character string that could be coerced into a formula, \code{split.formula()} returns a list containing character vectors corresponding to the predictor variables, the predictors, the response variables and the responses.
+}
+\usage{
+split.formula(x, simplify = FALSE)
+}
+\arguments{
+ \item{x}{
+ An object of type \code{formula} or a character scalar that could be interpreted as a formula (eg, using \code{as.formula}).
+}
+ \item{simplify}{
+ Simplify the formula. See \code{simplify} in \code{base::terms}.
+}
+}
+\details{
+ This function can be seen as providing more detailed information \code{as.character(as.formula(x))}.
+}
+\value{
+A list of formula components
+ \item{formula }{The original formula as a character string}
+ \item{response }{The LHS of the formula}
+ \item{response.vars }{The names of all variables in the LHS of the formula}
+ \item{predictors }{The terms in the RHS of the formula}
+ \item{predictor.vars }{The names of all variables in the RHS of the formula}
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+\seealso{
+}
+\examples{
+ sf <- split.formula(log(weight) ~ sex + age^2 + age + age:sex + (1|cohort))
+}
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/split.pathname.Rd b/man/split.pathname.Rd
new file mode 100644
index 0000000..1adeb71
--- /dev/null
+++ b/man/split.pathname.Rd
@@ -0,0 +1,50 @@
+\name{split.pathname}
+\alias{split.pathname}
+\title{Splits pathname of a file into its component parts
+}
+\description{
+ Uses the existing functions \code{basename} and \code{dirname} plus other regular expressions to return a separated list of the basename, directory name, extension and the ?core? of the pathname(s) passed as argument.
+}
+\usage{
+split.pathname(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/strcat.Rd b/man/strcat.Rd
new file mode 100644
index 0000000..41dcdbb
--- /dev/null
+++ b/man/strcat.Rd
@@ -0,0 +1,61 @@
+\name{strcat}
+\alias{strcat}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{strcat
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+strcat(..., sep = "")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+ \item{sep}{
+%% ~~Describe \code{sep} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (..., sep = "")
+{
+ paste(sep = sep, ...)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/string.trim.Rd b/man/string.trim.Rd
new file mode 100644
index 0000000..3f3b0f8
--- /dev/null
+++ b/man/string.trim.Rd
@@ -0,0 +1,56 @@
+\name{string.trim}
+\alias{string.trim}
+\title{Strip leading and trailing whitespace from elements of a character vector.
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+string.trim(s)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{s}{
+%% ~~Describe \code{s} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (s)
+{
+ gsub("^[[:space:]]+", "", gsub("[[:space:]]+$", "", s))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/tr.Rd b/man/tr.Rd
new file mode 100644
index 0000000..0567755
--- /dev/null
+++ b/man/tr.Rd
@@ -0,0 +1,56 @@
+\name{tr}
+\alias{tr}
+\title{Return the trace of a matrix.
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+tr(mat)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{mat}{
+%% ~~Describe \code{mat} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (mat)
+{
+ sum(diag(mat))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.aic.Rd b/man/unify.aic.Rd
new file mode 100644
index 0000000..98b3a68
--- /dev/null
+++ b/man/unify.aic.Rd
@@ -0,0 +1,58 @@
+\name{unify.aic}
+\alias{unify.aic}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.aic
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.aic(object)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object)
+{
+ 2 * unify.num.params(object) - 2 * unify.logLik(object)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.anova.Rd b/man/unify.anova.Rd
new file mode 100644
index 0000000..a3c7638
--- /dev/null
+++ b/man/unify.anova.Rd
@@ -0,0 +1,104 @@
+\name{unify.anova}
+\alias{unify.anova}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.anova
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.anova(object, test = NULL, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+ \item{test}{
+%% ~~Describe \code{test} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object, test = NULL, ...)
+{
+ retval <- NULL
+ make.dummy.anova <- function(object) {
+ predictors <- c("NULL", colnames(attr(terms(object),
+ "factors")))
+ data.frame(predictors = predictors, pvalue = rep(NA,
+ length(predictors)), logP = rep(NA, length(predictors)),
+ pctvar = rep(NA, length(predictors)))
+ }
+ if (inherits(object, "glm")) {
+ if (is.null(test))
+ test <- "Chisq"
+ an <- anova(object, test = test)
+ add <- data.frame(predictor = rownames(an), pvalue = an$"P(>|Chi|)")
+ add$logP <- -log10(add$pvalue)
+ add$pctvar <- NA
+ retval <- cbind(an, add)
+ }
+ else if (inherits(object, "lm")) {
+ if (is.null(test))
+ test <- "F"
+ pname <- switch(test, F = "Pr(>F)", NA)
+ if (is.na(test))
+ test <- NULL
+ an <- anova(object, test = test)
+ add <- data.frame(predictor = rownames(an), pvalue = an[,
+ pname])
+ add$logP <- -log10(add$pvalue)
+ tss <- SS(fitted(object) + residuals(object))
+ add$pctvar <- an$"Sum Sq"/tss * 100
+ retval <- cbind(an, add)
+ }
+ else if (inherits(object, "survreg") | inherits(object, "coxph") |
+ inherits(object, "polr") | inherits(object, "lmer") |
+ inherits(object, "glmer") | inherits(object, "mer")) {
+ retval <- make.dummy.anova(object)
+ }
+ else {
+ stop("No unify.anova() for objects of class ", paste(class(object),
+ collapse = "/"), "\n")
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.anova.list.Rd b/man/unify.anova.list.Rd
new file mode 100644
index 0000000..aaba912
--- /dev/null
+++ b/man/unify.anova.list.Rd
@@ -0,0 +1,197 @@
+\name{unify.anova.list}
+\alias{unify.anova.list}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.anova.list
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.anova.list(..., test = NULL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+ \item{test}{
+%% ~~Describe \code{test} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (..., test = NULL)
+{
+ unify.anova.list.lrt <- function(x, sort = FALSE) {
+ if (sort) {
+ x <- x[order(x$df), ]
+ }
+ x$delta.deviance <- c(NA, diff(-x$residual.deviance))
+ x$test <- c(NA, rep("Chisq", nrow(x) - 1))
+ x$pvalue <- c(NA, pchisq(x$delta.deviance[-1], df = diff(x$df),
+ lower.tail = FALSE))
+ x$logP <- -log10(x$pvalue)
+ x
+ }
+ objects <- list(...)
+ retval <- NULL
+ if (inherits(objects[[1]], "negbin")) {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects, function(x) {
+ formula.as.string(x$terms)
+ }, simplify = TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- retval$"Resid. df" - 1
+ retval$residual.deviance <- -retval$" 2 x log-lik."
+ nobs <- sapply(objects, function(x) {
+ length(resid(x))
+ }, simplify = TRUE)
+ retval$df <- nobs - retval$df.residual
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "glm")) {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects, function(x) {
+ formula.as.string(x$terms)
+ }, simplify = TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- retval$"Resid. Df"
+ retval$residual.deviance <- retval$"Resid. Dev"
+ nobs <- sapply(objects, function(x) {
+ length(resid(x))
+ }, simplify = TRUE)
+ retval$df <- nobs - retval$df.residual
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "lm")) {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects, function(x) {
+ formula.as.string(x$terms)
+ }, simplify = TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- retval$Res.Df
+ retval$residual.deviance <- retval$RSS
+ nobs <- sapply(objects, function(x) {
+ length(resid(x))
+ }, simplify = TRUE)
+ retval$df <- nobs - retval$df.residual
+ retval$delta.deviance <- retval$"Sum of Sq"
+ retval$test <- "F"
+ retval$pvalue <- retval$"Pr(>F)"
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "survreg")) {
+ for (k in 1:length(objects)) {
+ obj <- objects[[k]]
+ add <- data.frame(formula = formula.as.string(as.formula(obj$terms)),
+ residual.deviance = unify.deviance(obj), df.residual = obj$df.residual,
+ df = obj$df)
+ retval <- rbind(retval, add)
+ }
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "coxph")) {
+ for (k in 1:length(objects)) {
+ obj <- objects[[k]]
+ add <- data.frame(formula = formula.as.string(as.formula(obj$terms)),
+ residual.deviance = unify.deviance(obj), df.residual = obj$n -
+ sum(!is.na(coef(obj))), df = sum(!is.na(coef(obj))))
+ retval <- rbind(retval, add)
+ }
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "polr")) {
+ for (k in 1:length(objects)) {
+ obj <- objects[[k]]
+ add <- data.frame(formula = formula.as.string(as.formula(obj$terms)),
+ residual.deviance = unify.deviance(obj), df.residual = obj$df.residual,
+ df = obj$edf)
+ retval <- rbind(retval, add)
+ }
+ retval <- unify.anova.list.lrt(retval)
+ }
+ else if (inherits(objects[[1]], "glmer")) {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects, function(x) {
+ formula.as.string(x at terms)
+ }, simplify = TRUE)
+ retval$formula <- formulae
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$"Pr(>Chisq)"
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "mer")) {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects, function(x) {
+ formula.as.string(terms(x))
+ }, simplify = TRUE)
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$Pr
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else if (inherits(objects[[1]], "lmer")) {
+ retval <- as.data.frame(anova(...))
+ formulae <- sapply(objects, function(x) {
+ formula.as.string(terms(x))
+ }, simplify = TRUE)
+ retval$df.residual <- NA
+ retval$residual.deviance <- sapply(objects, unify.deviance)
+ retval$df <- retval$Df
+ retval$delta.deviance <- retval$Chisq
+ retval$test <- "Chisq"
+ retval$pvalue <- retval$Pr
+ retval$logP <- -log10(retval$pvalue)
+ }
+ else {
+ warning("Unrecognized class ", class(objects[[1]]), "in unify anova list\n")
+ retval <- anova(...)
+ }
+ rownames(retval) <- 1:nrow(retval)
+ zeros <- which(0 == retval$delta.deviance & !is.finite(retval$pvalue))
+ retval$pvalue[zeros] <- 1
+ retval$logP[zeros] <- 0
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.bic.Rd b/man/unify.bic.Rd
new file mode 100644
index 0000000..c2e1fec
--- /dev/null
+++ b/man/unify.bic.Rd
@@ -0,0 +1,61 @@
+\name{unify.bic}
+\alias{unify.bic}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.bic
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.bic(object, k = unify.num.params(object))
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+ \item{k}{
+%% ~~Describe \code{k} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object, k = unify.num.params(object))
+{
+ k * log(unify.num.obs(object)) - 2 * unify.logLik(object)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.deviance.Rd b/man/unify.deviance.Rd
new file mode 100644
index 0000000..b109ad4
--- /dev/null
+++ b/man/unify.deviance.Rd
@@ -0,0 +1,65 @@
+\name{unify.deviance}
+\alias{unify.deviance}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.deviance
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.deviance(object)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object)
+{
+ if (inherits(object, "mer")) {
+ return(deviance(object, REML = FALSE))
+ }
+ else if (hasS3method("deviance", object) | hasS4method("deviance",
+ object)) {
+ return(deviance(object))
+ }
+ -2 * unify.logLik(object)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.fit.Rd b/man/unify.fit.Rd
new file mode 100644
index 0000000..e4f6976
--- /dev/null
+++ b/man/unify.fit.Rd
@@ -0,0 +1,120 @@
+\name{unify.fit}
+\alias{unify.fit}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.fit
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.fit(formula, data, model.type = "linear", args = list())
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{formula}{
+%% ~~Describe \code{formula} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{model.type}{
+%% ~~Describe \code{model.type} here~~
+}
+ \item{args}{
+%% ~~Describe \code{args} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (formula, data, model.type = "linear", args = list())
+{
+ form <- as.formula(formula)
+ is.multilevel <- 0 < length(grep(pattern = "\\|", formula.as.string(form)))
+ type <- unify.model.types()[[model.type]]
+ if (is.null(type)) {
+ stop("Cannot currently fit models of type ", model.type,
+ "\n")
+ }
+ fit <- NULL
+ if (!is.multilevel) {
+ args$formula <- formula
+ args$data <- quote(data)
+ if ("gaussian" == type) {
+ fit <- do.call("lm", args = args)
+ }
+ else if (type \%in\% c("binomial", "Gamma", "poisson",
+ "quasipoisson")) {
+ args$family <- type
+ fit <- do.call("glm", args = args)
+ }
+ else if ("negative.binomial" == type) {
+ fit <- do.call("glm.nb", args = args)
+ }
+ else if ("survreg" == type) {
+ fit <- do.call("survreg", args = args)
+ }
+ else if ("coxph" == type) {
+ fit <- do.call("coxph", args = args)
+ }
+ else if ("polr" == type) {
+ fit <- do.call("polr", args = args)
+ }
+ else {
+ stop("Cannot fit unilevel model.type ", model.type,
+ "\n")
+ }
+ }
+ else {
+ require(lme4)
+ args$formula <- formula
+ args$data <- quote(data)
+ if ("gaussian" == type) {
+ fit <- do.call("lmer", args = args)
+ }
+ else if (type \%in\% c("binomial", "Gamma", "poisson",
+ "quasipoisson")) {
+ args$family <- type
+ fit <- do.call("lmer", args = args)
+ }
+ else {
+ stop("Cannot fit multilevel model.type ", model.type,
+ "\n")
+ }
+ }
+ fit
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.generic.model.type.Rd b/man/unify.generic.model.type.Rd
new file mode 100644
index 0000000..dc82d03
--- /dev/null
+++ b/man/unify.generic.model.type.Rd
@@ -0,0 +1,59 @@
+\name{unify.generic.model.type}
+\alias{unify.generic.model.type}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.generic.model.type
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.generic.model.type(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ lookup <- unify.model.types()
+ unlist(lookup)[match(x, names(lookup))]
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.has.model.type.Rd b/man/unify.has.model.type.Rd
new file mode 100644
index 0000000..dfc2e71
--- /dev/null
+++ b/man/unify.has.model.type.Rd
@@ -0,0 +1,58 @@
+\name{unify.has.model.type}
+\alias{unify.has.model.type}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.has.model.type
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.has.model.type(x)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{
+%% ~~Describe \code{x} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (x)
+{
+ x \%in\% names(unify.model.types())
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.is.multilevel.formula.Rd b/man/unify.is.multilevel.formula.Rd
new file mode 100644
index 0000000..e70d10a
--- /dev/null
+++ b/man/unify.is.multilevel.formula.Rd
@@ -0,0 +1,67 @@
+\name{unify.is.multilevel.formula}
+\alias{unify.is.multilevel.formula}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.is.multilevel.formula
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.is.multilevel.formula(form)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{form}{
+%% ~~Describe \code{form} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (form)
+{
+ if (is.null(form))
+ return(FALSE)
+ if (1 < length(form)) {
+ return(apply(as.array(form), 1, unify.is.multilevel.formula))
+ }
+ if (!is.formula(form)) {
+ if (is.na(form))
+ return(FALSE)
+ }
+ return(0 < length(grep(pattern = "\\|", formula.as.string(form))))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.logLik.Rd b/man/unify.logLik.Rd
new file mode 100644
index 0000000..d722570
--- /dev/null
+++ b/man/unify.logLik.Rd
@@ -0,0 +1,68 @@
+\name{unify.logLik}
+\alias{unify.logLik}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.logLik
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.logLik(object)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object)
+{
+ retval <- NULL
+ if (inherits(object, "survreg") | inherits(object, "coxph")) {
+ retval <- object$loglik[2]
+ }
+ else if (inherits(object, "mer")) {
+ retval <- as.numeric(logLik(object, REML = FALSE))
+ }
+ else {
+ retval <- as.numeric(logLik(object))
+ }
+ retval
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.model.types.Rd b/man/unify.model.types.Rd
new file mode 100644
index 0000000..4dfd579
--- /dev/null
+++ b/man/unify.model.types.Rd
@@ -0,0 +1,58 @@
+\name{unify.model.types}
+\alias{unify.model.types}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.model.types
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.model.types()
+}
+%- maybe also 'usage' for other objects documented here.
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function ()
+{
+ synonyms <- list(binary = "binomial", binomial = "binomial",
+ coxph = "coxph", Gamma = "Gamma", gamma = "Gamma", gaussian = "gaussian",
+ linear = "gaussian", negative.binomial = "negative.binomial",
+ negbin = "negative.binomial", ordinal = "polr", overdispersed.poisson = "negative.binomial",
+ poisson = "poisson", polr = "polr", quasipoisson = "quasipoisson",
+ survival = "survreg", survreg = "survreg")
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.num.obs.Rd b/man/unify.num.obs.Rd
new file mode 100644
index 0000000..1997ab5
--- /dev/null
+++ b/man/unify.num.obs.Rd
@@ -0,0 +1,59 @@
+\name{unify.num.obs}
+\alias{unify.num.obs}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.num.obs
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.num.obs(object)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object)
+{
+ ll <- logLik(object)
+ as.numeric(attr(ll, "nobs"))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.num.params.Rd b/man/unify.num.params.Rd
new file mode 100644
index 0000000..8be3814
--- /dev/null
+++ b/man/unify.num.params.Rd
@@ -0,0 +1,59 @@
+\name{unify.num.params}
+\alias{unify.num.params}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.num.params
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.num.params(object)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object)
+{
+ ll <- logLik(object)
+ as.numeric(attr(ll, "df"))
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.simulate.Rd b/man/unify.simulate.Rd
new file mode 100644
index 0000000..01d1fd4
--- /dev/null
+++ b/man/unify.simulate.Rd
@@ -0,0 +1,79 @@
+\name{unify.simulate}
+\alias{unify.simulate}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.simulate
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.simulate(object, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object, ...)
+{
+ if (inherits(object, "mer")) {
+ return(unify.simulate.lmer(object, ...))
+ }
+ else if (inherits(object, "glm")) {
+ type <- attr(object, "family")$family
+ if (type \%in\% c("binomial", "poisson")) {
+ return(simulate(object, ...))
+ }
+ else {
+ stop("Cannot currently simulate from ", type, " glm model\n")
+ }
+ }
+ else if (inherits(object, "lm")) {
+ return(simulate(object, ...))
+ }
+ else {
+ stop("Cannot currently simulate from model of type ",
+ class(object), "\n")
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/unify.simulate.lmer.Rd b/man/unify.simulate.lmer.Rd
new file mode 100644
index 0000000..4cf6553
--- /dev/null
+++ b/man/unify.simulate.lmer.Rd
@@ -0,0 +1,71 @@
+\name{unify.simulate.lmer}
+\alias{unify.simulate.lmer}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{unify.simulate.lmer
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+unify.simulate.lmer(object, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{
+%% ~~Describe \code{object} here~~
+}
+ \item{\dots}{
+%% ~~Describe \code{\dots} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (object, ...)
+{
+ return(simulate(object, ...))
+ if ("binomial" == type) {
+ out <- simulate(object, ...)
+ return(out)
+ }
+ if ("poisson" == type) {
+ return(simulate(object, ...))
+ }
+ else {
+ stop("Cannot currently simulate from ", type, " glmer model\n")
+ }
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/which.wide.ci.Rd b/man/which.wide.ci.Rd
new file mode 100644
index 0000000..e6ef63f
--- /dev/null
+++ b/man/which.wide.ci.Rd
@@ -0,0 +1,76 @@
+\name{which.wide.ci}
+\alias{which.wide.ci}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{which.wide.ci
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+which.wide.ci(counts, prob)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{counts}{
+%% ~~Describe \code{counts} here~~
+}
+ \item{prob}{
+%% ~~Describe \code{prob} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (counts, prob)
+{
+ cumfrac = cumsum(counts)/sum(counts)
+ tailfrac = ifelse(cumfrac > 0.5, 1 - cumfrac, cumfrac)
+ tailfrac.target = (1 - prob)/2
+ delta = tailfrac - tailfrac.target
+ ge0 = 0 <= delta
+ first.ge0 = which(ge0)[1]
+ lower.q = first.ge0
+ if (0 != delta[first.ge0] & 1 != first.ge0) {
+ lower.q = which(delta == delta[first.ge0 - 1])[1]
+ }
+ last.ge0 = rev(which(ge0))[1]
+ upper.q = last.ge0
+ if (0 != delta[last.ge0] & length(counts) != last.ge0) {
+ upper.q = rev(which(delta == delta[last.ge0 + 1]))[1]
+ }
+ c(lower.q, upper.q)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/wlm.multiresponse.Rd b/man/wlm.multiresponse.Rd
new file mode 100644
index 0000000..a14adc8
--- /dev/null
+++ b/man/wlm.multiresponse.Rd
@@ -0,0 +1,157 @@
+\name{wlm.multiresponse}
+\alias{wlm.multiresponse}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{wlm.multiresponse
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+wlm.multiresponse(formula, response.matrix, data, null.formula = NULL, rsquared = FALSE, pvalue = FALSE, logP = FALSE, LOD = FALSE, weights = rep(1, nrow(data)), model.args = list(), verbose.at.every = 0)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{formula}{
+%% ~~Describe \code{formula} here~~
+}
+ \item{response.matrix}{
+%% ~~Describe \code{response.matrix} here~~
+}
+ \item{data}{
+%% ~~Describe \code{data} here~~
+}
+ \item{null.formula}{
+%% ~~Describe \code{null.formula} here~~
+}
+ \item{rsquared}{
+%% ~~Describe \code{rsquared} here~~
+}
+ \item{pvalue}{
+%% ~~Describe \code{pvalue} here~~
+}
+ \item{logP}{
+%% ~~Describe \code{logP} here~~
+}
+ \item{LOD}{
+%% ~~Describe \code{LOD} here~~
+}
+ \item{weights}{
+%% ~~Describe \code{weights} here~~
+}
+ \item{model.args}{
+%% ~~Describe \code{model.args} here~~
+}
+ \item{verbose.at.every}{
+%% ~~Describe \code{verbose.at.every} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (formula, response.matrix, data, null.formula = NULL,
+ rsquared = FALSE, pvalue = FALSE, logP = FALSE, LOD = FALSE,
+ weights = rep(1, nrow(data)), model.args = list(), verbose.at.every = 0)
+{
+ formula <- as.formula(formula)
+ response.matrix <- as.matrix(response.matrix)
+ terms.object <- terms(formula)
+ if (0 == attr(terms.object, "response")) {
+ stop("Must specify response in formula\n")
+ }
+ if (1 != attr(terms.object, "response") | length(all.vars(terms.object)) !=
+ nrow(attr(terms.object, "factors"))) {
+ stop("Multivariate response not allowed\n")
+ }
+ response.name <- all.vars(terms.object)[1]
+ response.expr <- rownames(attr(terms.object, "factors"))[1]
+ if (response.name != response.expr) {
+ FUN2 <- eval(parse(text = paste("FUN <- function(", response.name,
+ "){", response.expr, "}", sep = "")))
+ response.matrix <- apply(response.matrix, 2, FUN2)
+ }
+ if (!all(is.finite(response.matrix))) {
+ stop("Response must be finite\n")
+ }
+ mlm.formula = paste("response.matrix ~", split.formula(formula)$predictor.string)
+ mlm.fit = do.call("lm", args = c(model.args, list(formula = as.formula(mlm.formula),
+ data = quote(data), weights = weights)))
+ mlm.sum = summary(mlm.fit)
+ rss = colSums(sapply(mlm.sum, function(x) {
+ x$residuals
+ })^2)
+ r2 = sapply(mlm.sum, function(x) {
+ x$r.squared
+ })
+ tss = rss/(1 - r2)
+ result <- list(n = NROW(resid(mlm.fit)), tss = tss, rss = rss,
+ rank = mlm.fit$rank, df.residual = mlm.fit$df.residual)
+ if (rsquared)
+ result$rsquared <- r2
+ if (!is.null(null.formula)) {
+ if (split.formula(formula)$response != split.formula(null.formula)$response) {
+ stop("Response expression in formula and null formula differ: ",
+ split.formula(null.formula)$response, " vs ",
+ split.formula(formula)$response, "\n")
+ }
+ mlm.formula0 = paste("response.matrix ~", split.formula(null.formula)$predictor.string)
+ mlm.fit0 <- do.call("lm", args = c(model.args, list(formula = as.formula(mlm.formula0),
+ data = quote(data), weights = weights)))
+ mlm.sum0 = summary(mlm.fit0)
+ result$null.rss = colSums(sapply(mlm.sum0, function(x) {
+ x$residuals
+ })^2)
+ result$null.rank = mlm.fit0$rank
+ if (pvalue | logP) {
+ dfr <- result$df.residual
+ delta.dfp <- result$rank - result$null.rank
+ fss <- result$null.rss - result$rss
+ f <- fss/rss * dfr/delta.dfp
+ if (pvalue | logP) {
+ pval <- pf(f, delta.dfp, dfr, lower.tail = F)
+ if (pvalue)
+ result$pvalue <- pval
+ if (logP)
+ result$logP <- -log10(pval)
+ }
+ }
+ if (LOD) {
+ result$LOD <- (result$n/2) * (log10(result$null.rss) -
+ log10(rss))
+ }
+ }
+ result
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/write.configfile.Rd b/man/write.configfile.Rd
new file mode 100644
index 0000000..452eed9
--- /dev/null
+++ b/man/write.configfile.Rd
@@ -0,0 +1,62 @@
+\name{write.configfile}
+\alias{write.configfile}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Write configurations to a configuration file
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+write.configfile(config, file)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{config}{
+%% ~~Describe \code{config} here~~
+}
+ \item{file}{
+%% ~~Describe \code{file} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (config, file)
+{
+ string <- paste(names(config), sep = "\t", as.character(unlist(config)),
+ collapse = "\n")
+ cat(string, "\n", file = file)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/write.delim.Rd b/man/write.delim.Rd
new file mode 100644
index 0000000..18c9745
--- /dev/null
+++ b/man/write.delim.Rd
@@ -0,0 +1,66 @@
+\name{write.delim}
+\alias{write.delim}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Write a tab-delimited file.
+}
+\description{
+ This function provides a partner function for \code{utils::read.delim()}.
+}
+\usage{
+write.delim(..., quote = FALSE, row.names = FALSE, sep = "\t")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{\dots}{
+ Arguments passed to \code{?utils::write.table()}/.
+}
+ \item{quote}{
+ Quote strings? See \code{?utils::write.table()}.
+}
+ \item{row.names}{
+ Whether to write row names. See \code{utils::write.table()}.
+}
+ \item{sep}{
+ The string separator. See \code{?utils::write.table()}.
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+William Valdar <william.valdar at unc.edu>
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (..., quote = FALSE, row.names = FALSE, sep = "\t")
+{
+ write.table(..., sep = sep, quote = quote, row.names = row.names)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/write.multiscan.max.Rd b/man/write.multiscan.max.Rd
new file mode 100644
index 0000000..e00d77e
--- /dev/null
+++ b/man/write.multiscan.max.Rd
@@ -0,0 +1,65 @@
+\name{write.multiscan.max}
+\alias{write.multiscan.max}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{write.multiscan.max
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+write.multiscan.max(results, file)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{results}{
+%% ~~Describe \code{results} here~~
+}
+ \item{file}{
+%% ~~Describe \code{file} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (results, file)
+{
+ best.LOD <- apply(results$scores.LOD, 2, max, na.rm = TRUE)
+ best.modelcmp <- apply(results$scores.modelcmp, 2, max, na.rm = TRUE)
+ out.data <- data.frame(scan.number = results$response.number,
+ best.LOD = best.LOD, best.modelcmp = best.modelcmp)
+ write.delim(out.data, file = file)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
diff --git a/man/write.scan.Rd b/man/write.scan.Rd
new file mode 100644
index 0000000..6bf2161
--- /dev/null
+++ b/man/write.scan.Rd
@@ -0,0 +1,74 @@
+\name{write.scan}
+\alias{write.scan}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{write.scan
+%% ~~function to do ... ~~
+}
+\description{
+%% ~~ A concise (1-5 lines) description of what the function does. ~~
+}
+\usage{
+write.scan(scan, filename)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{scan}{
+%% ~~Describe \code{scan} here~~
+}
+ \item{filename}{
+%% ~~Describe \code{filename} here~~
+}
+}
+\details{
+%% ~~ If necessary, more details than the description above ~~
+}
+\value{
+%% ~Describe the value returned
+%% If it is a LIST, use
+%% \item{comp1 }{Description of 'comp1'}
+%% \item{comp2 }{Description of 'comp2'}
+%% ...
+}
+\references{
+%% ~put references to the literature/web site here ~
+}
+\author{
+%% ~~who you are~~
+}
+\note{
+%% ~~further notes~~
+}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+%% ~~objects to See Also as \code{\link{help}}, ~~~
+}
+\examples{
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+## The function is currently defined as
+function (scan, filename)
+{
+ file <- file(filename, open = "wt")
+ scan$table$modelcmp.type <- scan$modelcmp.type
+ cat(file = file, "SCAN_RESULTS ", scan$date, "\n")
+ cat(file = file, "PHENOTYPE ", scan$phenotype, "\n")
+ cat(file = file, "POPULATION ", scan$population, "\n")
+ cat(file = file, "BUILD ", scan$build, "\n")
+ cat(file = file, "CHROMOSOME ", scan$chromosome, "\n")
+ cat(file = file, "NULL.FORMULA ", scan$null.formula, "\n")
+ cat(file = file, "TEST.FORMULA ", scan$test.formula, "\n")
+ cat(file = file, "PHASE ", scan$phase, "\n")
+ cat(file = file, "BEGIN_SCAN_DATA\n")
+ write.delim(file = file, scan$table)
+ cat(file = file, "END_SCAN_DATA\n")
+ close(file)
+ }
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-other-valdar-bagpipe.backend.git
More information about the debian-med-commit
mailing list