.packageName <- "GGtools"
setClass("snpMeta", 
  representation(meta="environment", chromosome="character"))

setGeneric("chromosome", function(x) standardGeneric("chromosome"))
setMethod("chromosome", "snpMeta", function(x) x@chromosome)

df2snpMeta = function(df, chrom) {
 mm = new.env()
 assign("meta", df, mm)
 new("snpMeta", meta=mm, chromosome=chrom)
}

setMethod("[", "snpMeta", function(x, i, j, ..., drop=FALSE) {
 if (missing(j)) get("meta", x@meta)[i,,drop=drop]
 else if (missing(i)) get("meta", x@meta)[,j,drop=drop]
 else get("meta", x@meta)[i,j,drop=drop]
})

setMethod("show", "snpMeta", function(object) {
 cat("snp metadata for chromosome", chromosome(object), "\n")
 cat("first five records:\n")
 print(object[1:5,])
})

setAs("snpMeta", "data.frame", function(from) get("meta", from@meta))
setMethod("dim", "snpMeta", function(x) dim(as(x, "data.frame")))
setMethod("nrow", "snpMeta", function(x) nrow(as(x, "data.frame")))


# GGtools AllClasses.R (c) 2006 VJ Carey

# helper classes to figure out semantics of character strings

setClass("snpID", contains="character")
snpID = function(x) new("snpID", x)

setClass("genesym", contains="character")
genesym = function(x) new("genesym", x)

setGeneric("snps", function(x) standardGeneric("snps"))

# helper class for snp screen output

setClass("snpScreenResult", representation(call="call", gene="character", 
    locs="numeric", chr="character", fittertok="character"), contains="list")

# key class for genetical genomics Aug 2006 -- rare allele
# count combined with expression (racExSet)

setClass("racExSet", representation(
    racAssays="AssayData",
    rarebase="character", SNPalleles="character"), contains="eSet",
    prototype = prototype(racAssays=assayDataNew()))

setMethod("initialize", "racExSet",
          function(.Object,
                   phenoData = new("AnnotatedDataFrame"),
                   experimentData = new("MIAME"),
                   annotation = character(),
                   exprs = new("matrix"),
		   racs = new("matrix"),
		   rarebase = character(),
                   SNPalleles = character()) {
            .Object = callNextMethod(.Object,
                           assayData = assayDataNew(
                             exprs=exprs),
                           phenoData = phenoData,
                           experimentData = experimentData,
                           annotation = annotation)
	    .Object@racAssays = assayDataNew(racs =racs)
            .Object@SNPalleles = SNPalleles
	    .Object@rarebase = rarebase
            .Object
          })

#
#setMethod("snps", "racExSet", function(x) get("racs",x@racAssays))
#setMethod("exprs", "racExSet", function(object) get("exprs",object@assayData))
#
#setGeneric("racAssays", function(x) standardGeneric("racAssays"))
#setMethod("racAssays", "racExSet", function(x) x@racAssays)
#setGeneric("snpNames", function(x) standardGeneric("snpNames"))
#setMethod("snpNames", "racExSet", function(x) featureNames(x@racAssays))
#setGeneric("rarebase", function(x) standardGeneric("rarebase"))
#setMethod("rarebase", "racExSet", function(x) x@rarebase)
#setGeneric("SNPalleles", function(x) standardGeneric("SNPalleles"))
#setMethod("SNPalleles", "racExSet", function(x) x@SNPalleles)
#
#setMethod("show", "racExSet", function(object) {
#    cat("racExSet instance (SNP rare allele count + expression)\n")
#    cat("rare allele count assayData:\n")
#  cat("  Storage mode:", storageMode(racAssays(object)), "\n")
#  nms <- selectSome(snpNames(object))
#  cat("  featureNames:", paste(nms, collapse=", "))
#  if ((len <- length(snpNames(object))) > length(nms))
#    cat(" (", len, " total)", sep="")
#  cat("\n  Dimensions:\n")
#  print(Biobase:::assayDataDims(racAssays(object)))
#  cat("\nexpression assayData\n")
#  cat("  Storage mode:", storageMode(object), "\n")
#  nms <- selectSome(featureNames(object))
#  cat("  featureNames:", paste(nms, collapse=", "))
#  if ((len <- length(featureNames(object))) > length(nms))
#    cat(" (", len, " total)", sep="")
#  cat("\n  Dimensions:\n")
#  print(dims(object))
#  cat("\nphenoData\n")
#  show(phenoData(object)) 
#  cat("\n")
#  show(experimentData(object))
#  cat("\nAnnotation ")
#  show(annotation(object))
#    })
#
#make_racExSet = function(exprs, racs, rarebase, SNPalleles, pd, mi, anno) {
#    if (!is(exprs, "matrix")) 
#        stop("exprs must be of class matrix")
#    if (!is(racs, "matrix")) 
#        stop("racs must be of class matrix")
#    if (!is(pd, "phenoData")) 
#        stop("pd must be of class phenoData")
#    names(SNPalleles) = rownames(racs)
#    names(rarebase) = rownames(racs)
#    new("racExSet", exprs=exprs, racs=racs, rarebase=rarebase, 
#        SNPalleles = SNPalleles,
#        phenoData = pd, experimentData = mi, 
#        annotation = anno)
#}
#
#
setGeneric("racAssays", function(x) standardGeneric("racAssays"))
setGeneric("snpNames", function(x) standardGeneric("snpNames"))
setGeneric("rarebase", function(x) standardGeneric("rarebase"))
setGeneric("SNPalleles", function(x) standardGeneric("SNPalleles"))

setGeneric("snpScreen", function(racExSet, snpMeta, gene, formTemplate, fitter, gran, ...)
    standardGeneric("snpScreen"))

HMworkflow = function(gzfn,emat,pd,mi,anno) {
# assumes gzfn is pathname of a gzipped HapMap file
# emat is rownames/columnames matrix of exprs
# pd is a phenoData structure
 savo = options()
 on.exit(options(savo))
 options(verbose=TRUE)
 require(GGtools)
 rac = thinHM2rac(gzfn)
 racm = rac$rarecount[, colnames(emat)] 
 new("racExSet", exprs=emat, racs=racm, rarebase=rac$rarebase,
   SNPalleles=rac$alleles, phenoData=pd, experimentData=mi,
   annotation=anno)
}


HM2rac = function (fn, comment.char = "", kppref = "NA") 
{
# SLOW!  see thinHM2rac below
    df = read.table(fn, comment.char = comment.char, h = TRUE)
    allel = as.character(df[, "SNPalleles"])
    kpcol = grep(kppref, names(df))
    df = df[, c(1, kpcol)]
    names(df)[1] = "rsnum"
    BAG = lapply(df, as.character)
    nsnp = nrow(df)
    nsam = ncol(df) - 1
    cmat = matrix(" ", nrow = nsnp, nc = nsam)
    for (i in 1:nsam) cmat[, i] = BAG[[i + 1]]
    names(allel) = rownames(cmat) = BAG[[1]]
    colnames(cmat) = names(df)[-1]
    rr = apply(cmat, 1, countRare)
    rrr = apply(cmat, 1, getRare)
    vdf = data.frame("sampID"=colnames(cmat))
    vmdf = data.frame(labelDescription="sample ID in CEPH system")
    class(vmdf[,1]) = "character"
    vmdf[1,1] = "sample ID in CEPH system"
    rownames(vmdf) = "sampID"
    adf = new("AnnotatedDataFrame", data=vdf, varMetadata=vmdf)
    list(raremat = t(rr), alleles=allel, rareallele = rrr, anno=adf)
}


thinHM2rac = function(gzfn) {
#
# here we scan in the gzipped data line by line and
# build up the matrix
#
 stats = system(paste("gunzip -c", gzfn, "|wc"), intern=TRUE)
 stats = as.numeric(strsplit(stats, "\ +")[[1]])
 ntokpline = stats[3]/stats[2]
 nline = stats[2]-1 # header
 nind = ntokpline - 11
 rarecount = matrix(NA, nr=nline, nc=nind)
 alleles = rep(NA, nline)
 rarebase = rep(NA, nline)
 rsnum = rep(NA, nline)
 ff = gzfile(gzfn)
 open(ff, "r")
 hd = scan(ff, "", n=ntokpline, quiet=TRUE)
 snames = hd[-c(1:11)]
 cat(paste(nline, "lines to process\n"))
 for (i in 1:nline)
   {
   if (i %% 500 == 0) cat(i)
   tmp = scan(ff, "", n=ntokpline, quiet=TRUE)
   rarebase[i] = getRare(tmp[-c(1:11)])
   rarecount[i,] = countRare(tmp[-c(1:11)])
   rsnum[i] = tmp[1]
   alleles[i] = tmp[2]
   }
 rownames(rarecount) = rsnum
 colnames(rarecount) =  snames
 list(rarecount=rarecount, rarebase=rarebase, 
       alleles=alleles)
}
 
thinHM2meta = function(gzfn,chr) {
#
# here we scan in the gzipped data line by line and
# build up the matrix
#
 stats = system(paste("gunzip -c", gzfn, "|wc"), intern=TRUE)
 stats = as.numeric(strsplit(stats, "\ +")[[1]])
 ntokpline = stats[3]/stats[2]
 nline = stats[2]-1 # header
 nind = ntokpline - 11
 pos = rep(NA, nline)
 strand = rep(NA, nline)
 rsnum = rep(NA, nline)
 ff = gzfile(gzfn)
 open(ff, "r")
 hd = scan(ff, "", n=ntokpline, quiet=TRUE)
# snames = hd[-c(1:11)]
 cat(paste(nline, "lines to process\n"))
 for (i in 1:nline)
   {
   if (i %% 500 == 0) cat(i)
   tmp = scan(ff, "", n=ntokpline, quiet=TRUE)
   rsnum[i] = tmp[1]
   pos[i] = as.numeric(tmp[4])
   strand[i] = tmp[5]
   }
ans = data.frame(pos=as.numeric(pos), strand=strand)
rownames(ans) = rsnum
df2snpMeta(ans,chr)
}

exclMono = function (res) 
{
# exclude monomorphic loci
    lu = apply(snps(res), 1, function(x) length(unique(x[!is.na(x)])))
    sn = snps(res)[lu > 1, ]
    make_racExSet(exprs(res), sn, rarebase(res)[lu>1], SNPalleles(res)[lu>1], 
        phenoData(res), experimentData(res), annotation(res))
}

countRare = function(x) {
 unph = strsplit(x,"")
 nunph = lapply(unph, function(x) if(any(x == "N")) return(c(NA,NA)) else return(x))
 ac = table(unlist(nunph))
 comm = names(ac)[which.min(ac)]
 sapply(nunph, function(x) sum(x == comm))
}
getRare = function(x) {
 unph = strsplit(x,"")
 nunph = lapply(unph, function(x) if(any(x == "N")) return(c(NA,NA)) else return(x))
 ac = table(unlist(nunph))
 rare = names(ac)[which.min(ac)]
 rare
}

fastAGM = function(snpm, exprv) {
 if (any(is.na(snpm))) stop("some missing genotypes; should not get to this point")
 ans = .C("mreg_engine", as.integer(nrow(snpm)),
    as.integer(ncol(snpm)), as.double(exprv), as.double(snpm),
    b=double(nrow(snpm)), se=double(nrow(snpm)))
 trat = ans$b/ans$se
 pval = pmin(1,2*pt(-abs(trat),df=length(exprv)-2))
 names(ans$b) = names(ans$se) = names(trat)= names(pval) = rownames(snpm)
 list(b=ans$b, se=ans$se, trat=trat, pval=pval)
}

fastHET = function(snpm, exprv) {
 if (any(is.na(snpm))) stop("some missing genotypes; should not get to this point")
 ans = .C("mreg_engine", as.integer(nrow(snpm)),
    as.integer(ncol(snpm)), as.double(exprv), as.double(snpm==1),
    b=double(nrow(snpm)), se=double(nrow(snpm)))
 trat = ans$b/ans$se
 pval = pmin(1,2*pt(-abs(trat),df=length(exprv)-2))
 names(ans$b) = names(ans$se) = names(trat)= names(pval) = rownames(snpm)
 list(b=ans$b, se=ans$se, trat=trat, pval=pval)
}
genoStrings = function(racExSet, rsnum) {
 rac = snps(racExSet)[rsnum,]
 rar = rarebase(racExSet)[rsnum]
 gt = SNPalleles(racExSet)[rsnum]
 gts = as.character(strsplit(gt,"/")[[1]])
 com = gts[gts!=rar]
 opts = c( homrar=paste(rar,rar,sep="/"), het=as.character(gt), homcom=paste(com,com,sep="/"))
 crac = as.character(rac)
 crac[rac==0] = opts["homcom"]
 crac[rac==1] = opts["het"]
 crac[rac==2] = opts["homrar"]
 crac
}
 

setGeneric("oneFit", function(racExSet, geneid, snpid, fitfun, ...)
  standardGeneric("oneFit"))

getpsid = function( geneid, annostring, one.only=TRUE ) {
  require(annostring, character.only=TRUE)
  lkmemo = paste(annostring, "SYMMEMO", sep="")
  if (exists(lkmemo)) {
     memo = get(lkmemo)
     kp = which(geneid == names(memo))
     if (length(kp) == 0) stop(paste("could not find", geneid, "in memo structure."))
     if (length(kp) > 1) warning(paste(geneid, "has multiple probesets, using first."))
     return( memo[kp[1]] )
     }
  gnlist = as.list(get(paste(annostring,"SYMBOL",sep="")))
  fonly = sapply(gnlist, function(x)x[1]) # sometimes there are multiple symbols for aprobeset
  find = which(fonly == geneid)
  if (one.only) {
     psid = names(fonly)[find[1]]
     if (length(find) > 1) warning(paste("multiple probesets match", geneid, 
	"using", psid))
     }
  else psid = names(fonly)[find]
  psid
}

#setClass("genesym", contains="character")
#genesym = function(x) new("genesym", x)

setMethod("oneFit", c("racExSet", "genesym", "character", "function"),
  function(racExSet, geneid, snpid, fitfun, ...) {
    psid = getpsid( geneid, annotation(racExSet) )
    snpvals = snps(racExSet)[snpid,]
    exvals = exprs(racExSet)[psid,]
    ndf = data.frame(exvals,snpvals)
    names(ndf) = c(geneid, snpid)
    fmla = as.formula(paste(as.character(geneid), "~",
		as.character(snpid)))
    fitfun(fmla, data=ndf)
})

setMethod("oneFit", c("racExSet", "character", "character", "function"),
  function(racExSet, geneid, snpid, fitfun, ...) {
    snpvals = snps(racExSet)[snpid,]
    exvals = exprs(racExSet)[geneid,]
    ndf = data.frame(exvals,snpvals)
    names(ndf) = c(geneid, snpid)
    fmla = as.formula(paste(as.character(geneid), "~",
		as.character(snpid)))
    fitfun(fmla, data=ndf)
})

setMethod("oneFit", c("racExSet", "list", "character", "function"),
  function(racExSet, geneid, snpid, fitfun, ...) {
    snpvals = snps(racExSet)[snpid,]
    exvals = geneid
    if (length(geneid) > 1) stop("geneid must be list of length 1")
    geneName = names(geneid)
    if (length(geneName) == 0) stop("geneid must have names attr")
    exvals = geneid[[1]]
    if (!is.numeric(exvals)) stop("geneid list content must be numeric")
    geneid = geneName
## as before below
    if (length(exvals) != length(snpvals)) stop("lengths of numeric expression data and snp allele counts do not agree")
    ndf = data.frame(exvals,snpvals)
    names(ndf) = c(geneid, snpid)
    fmla = as.formula(paste(as.character(geneid), "~",
		as.character(snpid)))
    fitfun(fmla, data=ndf)
})

setMethod("oneFit", c("racExSet", "list", "formula", "function"),
  function(racExSet, geneid, snpid, fitfun, ...) {
#    fixFmla = function(x) {
#      x = as.character(x)
#      x = x[x != "~"]
#      x = strsplit(x, "\\+")
#      extractVars = function(x) gsub(" ","",gsub(")","", gsub("factor\\(","",x)))
#      as.character(sapply(x, extractVars))
#      }
    if (length(as.list(snpid))>2) stop("formula must be of form ~..., no dep. var.")
    snpvars = all.vars(snpid)
    snpvals = snps(racExSet)[snpvars,]
    if (length(snpvars)>1) snpvals=t(snpvals)
    exvals = geneid
    if (length(geneid) > 1) stop("geneid must be list of length 1")
    geneName = names(geneid)
    if (length(geneName) == 0) stop("geneid must have names attr")
    exvals = geneid[[1]]
    if (!is.numeric(exvals)) stop("geneid list content must be numeric")
    geneid = geneName
## as before below
#    if (length(exvals) != length(snpvals)) stop("lengths of numeric expression data and snp allele counts do not agree")
    ndf = data.frame(exvals,snpvals)
    names(ndf) = c(geneid, snpvars)
# now build the formula required by fitfun out of the formula fragment and depvar name
    snpid[[3]] = snpid[[2]]
    snpid[[2]] = as.name(substitute(geneid))
    fitfun(snpid, data=ndf)
})
setMethod("snps", "racExSet", function(x) get("racs",x@racAssays))
setMethod("exprs", "racExSet", function(object) get("exprs",object@assayData))
setMethod("racAssays", "racExSet", function(x) x@racAssays)
setMethod("snpNames", "racExSet", function(x) featureNames(x@racAssays))
setMethod("rarebase", "racExSet", function(x) x@rarebase)
setMethod("SNPalleles", "racExSet", function(x) x@SNPalleles)


setMethod("snpScreen", c("racExSet", "snpMeta", "genesym", "formula", "function", "numeric"),
   function (racExSet, snpMeta, gene, formTemplate = ~., fitter = lm, 
      gran = 1, ...) 
  {
      runTemplate = function(x, y) {
          z = as.character(x)
          z[2] = gsub("\\.", y, z[2])
          as.formula(z)
      }
      psid = getpsid(gene, annotation(racExSet))
      y = exprs(racExSet)[psid, ]
      outco = list(y)
      names(outco) = as.character(gene)
      nsnp = length(sn <- snpNames(racExSet))
      snpstodo = sn[inuse <- seq(1, nsnp, gran)]
      if (any(is.na(snpstodo))) snpstodo = snpstodo[!is.na(snpstodo)]
      allpos = get("meta", snpMeta@meta)$pos
      allsn = rownames(get("meta", snpMeta@meta))
      names(allpos) = allsn
      snpstodo = intersect(snpstodo, allsn)
      locs = allpos[snpstodo]
      fittertok = deparse(substitute(fitter))
      callsave = match.call()
      out = list()
      if (fittertok %in% c("fastAGM", "fastHET")) {
        tmp = snps(racExSet)[snpstodo,]
        bad = apply(tmp,1,function(x) any(is.na(x)))
        if (any(bad)) {
           warning("some genotype results had missing values; associated SNPs are dropped completely in this version when fastAGM is used.")
           snpstodo = snpstodo[-which(bad)]
           }
        locs = allpos[snpstodo]
        if (fittertok == "fastAGM") ans = fastAGM(snps(racExSet)[snpstodo,], y)
        else if (fittertok == "fastHET") ans = fastHET(snps(racExSet)[snpstodo,], y)
        return(new("snpScreenResult", call=callsave, locs=locs, 
            chr=chromosome(snpMeta), fittertok=fittertok, gene=as.character(gene), ans))
      }
      for (i in 1:length(snpstodo)) {
          if (options()$verbose == TRUE) {
              if (i%%100 == 0) 
                  cat(i)
          }
          fm = runTemplate(formTemplate, snpstodo[i])
          out[[i]] = try(oneFit(racExSet, outco, fm, fitter))
      }
      names(out) = snpstodo
      new("snpScreenResult", call = callsave, locs = locs, chr = chromosome(snpMeta), 
        fittertok = fittertok, gene=as.character(gene), out)
})


setMethod("show", "racExSet", function(object) {
    cat("racExSet instance (SNP rare allele count + expression)\n")
    cat("rare allele count assayData:\n")
  cat("  Storage mode:", storageMode(racAssays(object)), "\n")
  nms <- selectSome(snpNames(object))
  cat("  featureNames:", paste(nms, collapse=", "))
  if ((len <- length(snpNames(object))) > length(nms))
    cat(" (", len, " total)", sep="")
  cat("\n  Dimensions:\n")
  print(Biobase:::assayDataDims(racAssays(object)))
  cat("\nexpression assayData\n")
  cat("  Storage mode:", storageMode(object), "\n")
  nms <- selectSome(featureNames(object))
  cat("  featureNames:", paste(nms, collapse=", "))
  if ((len <- length(featureNames(object))) > length(nms))
    cat(" (", len, " total)", sep="")
  cat("\n  Dimensions:\n")
  print(dims(object))
  cat("\nphenoData\n")
  show(phenoData(object)) 
  cat("\n")
  show(experimentData(object))
  cat("\nAnnotation ")
  show(annotation(object))
    })

make_racExSet = function(exprs, racs, rarebase, SNPalleles, pd, mi, anno) {
    if (!is(exprs, "matrix")) 
        stop("exprs must be of class matrix")
    if (!is(racs, "matrix")) 
        stop("racs must be of class matrix")
    if (!is(pd, "phenoData") & !is(pd, "AnnotatedDataFrame")) 
        stop("pd must be of class phenoData or AnnotatedDataFrame")
    names(SNPalleles) = rownames(racs)
    names(rarebase) = rownames(racs)
    new("racExSet", exprs=exprs, racs=racs, rarebase=rarebase, 
        SNPalleles = SNPalleles,
        phenoData = pd, experimentData = mi, 
        annotation = anno)
}

plot_EvG = function(reset, gene, snpid, anno="hgfocus") {
 gn = getpsid(gene, anno)
 y = exprs(reset)[gn,]
 x = snps(reset)[snpid,]
 plot(x,y,ylab=paste("log", gene, "expression"), xlab=paste("minor allele count,",
  snpid), pch=20)
}

setGeneric("racAssays<-", function(object,value)standardGeneric("racAssays<-"))
setReplaceMethod("racAssays", c("racExSet", "AssayData"), function(object, value) {
 object@racAssays = value
 object
})

setMethod("[", "racExSet", function(x, i, j, ..., drop=FALSE) {
 if (is(i, "genesym")) callNextMethod()
 else if (is(i, "snpID")) {
    sel = get("racs", x@racAssays)
    sel = sel[i,,drop=FALSE]
    x@racAssays = assayDataNew("lockedEnvironment", racs=sel)
 }
 x
})
setMethod("show", "snpScreenResult", function(object) {
   cat("GGtools snpScreenResult for call:\n")
   print(object@call)
   if (!(object@fittertok  %in% c("fastAGM", "fastHET"))) {
     cat("There were", nf <- length(object), "attempted fits,\n")
     nerr = sum(sapply(object, function(x) inherits(x, "try-error")))
     cat("and", nf-nerr, "were successful.\n")
   }
   else {
     cat("There were", nf <- length(object[[4]]), "attempted fits,\n")
     nerr = sum(is.na(object[[4]])) + sum(is.nan(object[[4]]))
     cat("and", nf-nerr, "were successful.\n")
   }
})

extract_p = function(ssr) {
  if (ssr@fittertok %in% c("fastAGM", "fastHET")) return(ssr[["pval"]])
  if (ssr@fittertok != "lm") stop("code is idiosyncratic for lm fits")
  ps = as.numeric(sapply(ssr, function(x) try(summary(x)$coef[2,4],silent=TRUE)))
}


plot_mlp = function (ssr, snpMeta, ps = NULL, pch = 20, cex = 0.5, local = FALSE) 
{
    if (ssr@fittertok %in% c("fastAGM", "fastHET"))
        ps = ssr[["pval"]]
    else if (ssr@fittertok != "lm") 
        stop("code is idiosyncratic for lm fits")
    if (is.null(ps)) 
        ps = as.numeric(sapply(ssr, function(x) try(summary(x)$coef[2, 
            4], silent = TRUE)))
    if (length(ssr@locs) > 200) 
        plotf = smoothScatter
    else plotf = plot
    data(geneLocs)
    x = geneLocs[geneLocs$gene == ssr@gene, ]
    if (nrow(x) == 0) 
        return(invisible(NULL))
    gchr = x[1, "chr"]
    bad = which(is.na(ps))
    if (!local) 
        XLIM = range(snpMeta[, "pos"])
    else {
        snpn = unlist(lapply(ssr, function(x) names(coef(x))[2]))
        XLIM = range(snpMeta[snpn, "pos"])
    }
    if (length(bad)>0) {
          ssr@locs = ssr@locs[-bad]
          ps = ps[-bad]
    }
    plotf(ssr@locs, -log10(ps), xlab = paste("location on chromosome", 
        chromosome(snpMeta)), ylab = "-log10 p Ho:Bs=0", main = paste(ssr@gene, 
        "(chr", gchr, ")"), xlim = XLIM, pch = pch, cex = cex)
    for (i in 1:nrow(x)) {
        axis(3, at = x[i, "beg"], labels = FALSE, col = "green")
        axis(3, at = x[i, "end"], labels = FALSE, col = "red")
    }
    return(invisible(list(x = ssr@locs, y = -log10(ps))))
}
snps3PrimeTo = function(gn, rad=50000) {
 chr = as.character(geneLocs[gn,"chr"])
 metaDat = paste("chr", chr, "meta", sep="")
 md = get(metaDat)
 snpdf =  get("meta", md@meta)
 pos = snpdf[,"pos"]
 ini = geneLocs[gn,"end"]
 las = ini+50000
 snpID(rownames(snpdf)[which(pos > ini & pos < las)])
}
 
 
 
snps5PrimeTo = function(gn, rad=50000) {
 chr = as.character(geneLocs[gn,"chr"])
 metaDat = paste("chr", chr, "meta", sep="")
 md = get(metaDat)
 snpdf =  get("meta", md@meta)
 pos = snpdf[,"pos"]
 ini = geneLocs[gn,"beg"]
 las = ini-50000
 snpID(rownames(snpdf)[which(pos > las & pos < ini)])
}

snpsNear = function(gn, rad=50000) {
 chr = as.character(geneLocs[gn,"chr"])
 metaDat = paste("chr", chr, "meta", sep="")
 md = get(metaDat)
 snpdf =  get("meta", md@meta)
 pos = snpdf[,"pos"]
 ini = geneLocs[gn,"beg"]
 las = ini-50000
 tail = geneLocs[gn,"end"]
 las2 = tail+50000
 snpID(rownames(snpdf)[which(pos > las & pos < las2)])
}
# by Martin Morgan (14 Sep 2006)

setMethod("updateObject",
          signature(object="racExSet"),
          function(object, ..., verbose=FALSE) {
              if (verbose)
                message("updateObject(object = racExSet)")
              if (!isS4(object)) {
                  new("racExSet",
                      phenoData=updateObject(phenoData(object), verbose=verbose),
                      experimentData=updateObject(experimentData(object), verbose=verbose),
                      annotation=updateObject(annotation(object), verbose=verbose),
                      exprs=exprs(object),
                      racs=snps(object),
                      SNPalleles=SNPalleles(object)
                      )
              } else object
          })


.First.lib <- function(lib, pkg) {
   library.dynam("mreg", pkg, lib)
   }

