stupidSplineBasis <- function(x,knots){
  x <- pmin(x,knots[3])
  x <- pmax(x,knots[1])
  cbind(1, x, x^2, pmax(0, (x-knots[2]))^2)
}

changeToCrlmmAnnotationName <- function(x){
  pkgDir <- system.file(package=THISPKG)
  wanted <- paste(tolower(gsub("_", "", x)), "crlmm.stuff", sep=".")
  file.path(pkgDir, "extdata", wanted)
}

getCrlmmAnnotationName <- function(x){
  paste(tolower(gsub("_", "", x)), "Crlmm", sep="")
}

medianSummaries <- function(mat, grps)
  .Call("R_subColSummarize_median", mat, grps, PACKAGE = "preprocessCore")

intMedianSummaries <- function(mat, grps)
  as.integer(medianSummaries(mat, grps))



## .crlmmPkgEnv is an enviroment that will
## store all the variables used by the pkg.
## it's meant to not overwrite user's variables
## and get rid of the NOTES generated by
## R CMD check

isLoaded <- function(dataset, environ=.crlmmPkgEnv)
  exists(dataset, envir=environ)
getVarInEnv <- function(dataset, environ=.crlmmPkgEnv){
  if (!isLoaded(dataset))
    stop("Variable ", dataset, " not found in .crlmmPkgEnv")
  environ[[dataset]]
}

list2SnpSet <- function(x, returnParams=FALSE){
  pd <- data.frame(SNR=x[["SNR"]], gender=x[["gender"]],
                   batchQC=rep(x[["batchQC"]], ncol(x[["calls"]])),
                   row.names=colnames(x[["calls"]]))
  pdv <- data.frame(labelDescription=c("Signal-to-noise Ratio",
                      "Gender: Male (1) and Female (2)",
                      "Quality score for batch"),
                    row.names=c("SNR", "gender", "batchQC"))

  recall <- length(x[["DD"]]) > 1
  if (returnParams){
    if (recall){
      fd <- data.frame(SNPQC=x[["SNPQC"]],
                       cAA=x[["params"]][["centers"]][,1],
                       cAB=x[["params"]][["centers"]][,2],
                       cBB=x[["params"]][["centers"]][,3],
                       sAA=x[["params"]][["scales"]][,1],
                       sAB=x[["params"]][["scales"]][,2],
                       sBB=x[["params"]][["scales"]][,3],
                       nAA=x[["params"]][["N"]][,1],
                       nAB=x[["params"]][["N"]][,2],
                       nBB=x[["params"]][["N"]][,3],
                       spAA=x[["DD"]][,1],
                       spAB=x[["DD"]][,2],
                       spBB=x[["DD"]][,3],
                       row.names=rownames(x[["calls"]]))
      fdv <- data.frame(labelDescription=c(
                          "SNP Quality Score",
                          "Center AA", "Center AB", "Center BB",
                          "Scale AA", "Scale AB", "Scale BB",
                          "N AA", "N AB", "N BB",
                          "Shift in parameters AA",
                          "Shift in parameters AB",
                          "Shift in parameters BB"),
                        row.names=c(
                          "SNPQC",
                          "cAA", "cAB", "cBB",
                          "sAA", "sAB", "sBB",
                          "nAA", "nAB", "nBB",
                          "spAA", "spAB", "spBB"))
    }else{
      fd <- data.frame(SNPQC=x[["SNPQC"]],
                       cAA=x[["params"]][["centers"]][,1],
                       cAB=x[["params"]][["centers"]][,2],
                       cBB=x[["params"]][["centers"]][,3],
                       sAA=x[["params"]][["scales"]][,1],
                       sAB=x[["params"]][["scales"]][,2],
                       sBB=x[["params"]][["scales"]][,3],
                       nAA=x[["params"]][["N"]][,1],
                       nAB=x[["params"]][["N"]][,2],
                       nBB=x[["params"]][["N"]][,3],
                       row.names=rownames(x[["calls"]]))
      fdv <- data.frame(labelDescription=c(
                          "SNP Quality Score",
                          "Center AA", "Center AB", "Center BB",
                          "Scale AA", "Scale AB", "Scale BB",
                          "N AA", "N AB", "N BB"),
#                          "Shift in parameters AA",
#                          "Shift in parameters AB",
#                          "Shift in parameters BB"),
                        row.names=c(
                          "SNPQC",
                          "cAA", "cAB", "cBB",
                          "sAA", "sAB", "sBB",
                          "nAA", "nAB", "nBB"))
    }
  }else{
    if (recall){
      fd <- data.frame(SNPQC=x[["SNPQC"]],
                       spAA=x[["DD"]][,1],
                       spAB=x[["DD"]][,2],
                       spBB=x[["DD"]][,3],
                       row.names=rownames(x[["calls"]]))
      fdv <- data.frame(labelDescription=c("SNP Quality Score",
                          "Shift in parameters AA",
                          "Shift in parameters AB",
                          "Shift in parameters BB"),
                        row.names=c("SNPQC", "spAA", "spAB", "spBB"))
    }else{
      fd <- data.frame(SNPQC=x[["SNPQC"]],
                       row.names=rownames(x[["calls"]]))
      fdv <- data.frame(labelDescription=c("SNP Quality Score"),
                        row.names=c("SNPQC"))
    }
  }
  new("SnpSet",
      assayData=assayDataNew("lockedEnvironment",
        call=x[["calls"]], callProbability=x[["confs"]]),
      phenoData=new("AnnotatedDataFrame",
        data=pd, varMetadata=pdv),
      featureData=new("AnnotatedDataFrame",
        data=fd, varMetadata=fdv),
      annotation=x[["pkgname"]])
}

loader <- function(theFile, envir, pkgname){
	theFile <- file.path(system.file(package=pkgname),
			     "extdata", theFile)
	if (!file.exists(theFile))
		stop("File ", theFile, " does not exist in ", pkgname)
	load(theFile, envir=envir)
}

celDates <- function(celfiles){
	if(!all(file.exists(celfiles))) stop("1 or more cel file does not exist")
	celdates <- vector("character", length(celfiles))
	celtimes <- vector("character", length(celfiles))
	for(i in seq(along=celfiles)){
		if(i %% 100 == 0) cat(".")
		tmp <- read.celfile.header(celfiles[i], info="full")$DatHeader
		tmp <- strsplit(tmp, "\ +")
		celdates[i] <- tmp[[1]][6]
		celtimes[i] <- tmp[[1]][7]
	}
	tmp <- paste(celdates, celtimes)
	celdts <- strptime(tmp, "%m/%d/%y %H:%M:%S")
	return(celdts)
}

validCdfNames <- function(){
	c("genomewidesnp6",
	  "genomewidesnp5",
	  "human370v1c",
	  "human370quadv3c",
	  "human550v3b",
	  "human650v3a",
	  "human610quadv1b",
	  "human660quadv1a",
	  "human1mduov3b",
	  "humanomni1quadv1b")
}
isValidCdfName <- function(cdfName){
	chipList <- validCdfNames()
	result <- cdfName %in% chipList	
	if(!(result)){
		warning("cdfName must be one of the following: ",
			chipList)
	}
	return(result)
}

isPackageLoaded <- function(pkg){
	stopifnot(is.character(pkg))
	pkg <- paste("package:", pkg, sep="")
	pkg %in% search()
}

paramNames <- function(){
	c("tau2A", "tau2B", "sig2A", "sig2B",
	  "nuA", "nuA.se", "nuB",  "nuB.se", "phiA", "phiB", "phiAX", "phiBX",
	  "phiA.se", "phiB.se", "corr", "corrA.BB", "corrB.AA")
}

initializeParamObject <- function(dimnames){
	nr <- length(dimnames[[1]])
	nc <- length(dimnames[[2]])		
	ll <- vector("list", 17)
	name <- paramNames()
	if(isPackageLoaded("ff")){
		for(i in 1:17) ll[[i]] <- createFF(name=name[i], dim=c(nr, nc), vmode="double")            ##ff(vmode="double", dim=c(nr, nc), pattern=file.path(ldPath(), name[i]), dimnames=dimnames, overwrite=TRUE)
		names(ll) <- paramNames()
		ll <- do.call(ffdf, ll)
	} else {
		for(i in 1:17) ll[[i]] <- matrix(NA, nr, nc, dimnames=dimnames)
		names(ll) <- paramNames()
	}
	return(ll)
}


initializeBigMatrix <- function(name, nr, nc, vmode="integer"){
	if(isPackageLoaded("ff")){
		if(prod(nr, nc) > 2^31){
			##Need multiple matrices
			## -- use ffdf
			## How many samples per ff object
			S <- floor(2^31/nr - 1)
			## How many ff objects
			L <- ceiling(nc/S)
			name <- paste(name, 1:L, sep="_")
			resultsff <- vector("list", L)
			##resultsB <- vector("list", L)			
			for(i in 1:(L-1)){  ## the Lth object may have fewer than nc columns
				resultsff[[i]] <- createFF(name=name[i],
							   dim=c(nr, S),
							   vmode=vmode)
			}
			##the Lth element
			leftOver <- nc - ((L-1)*S)
			resultsff[[L]] <- createFF(name=name[L],
						   dim=c(nr, leftOver),
						   vmode=vmode)
			resultsff[[L]][,] <- NA
			results <- do.call(ffdf, resultsff)
			rm(resultsff); gc()
			##dimnames(resultsff) <- dns
		} else {
			results <- createFF(name=name,
					    dim=c(nr, nc),
					    vmode=vmode)
			results[,] <- NA
		}
	}  else results <- matrix(NA, nr, nc)
	return(results)
}
setMethod("annotatedDataFrameFrom", "ff_matrix", Biobase:::annotatedDataFrameFromMatrix)
setMethod("annotatedDataFrameFrom", "ffdf", Biobase:::annotatedDataFrameFromMatrix)


##annotatedDataFrameFromFF <- function (object, byrow = FALSE, ...){
##    dims <- dim(object)
##    if (is.null(dims) || all(dims == 0)) 
##        annotatedDataFrameFrom(NULL, byrow = byrow, ...)
##    else {
##        N <- if (byrow)  dims[1]       else dims[2]
##        nms <- if (byrow) rownames(object)  else colnames(object)
##        data <- data.frame(numeric(N), row.names = nms)[, FALSE]
##        dimLabels <- if (byrow) c("featureNames", "featureColumns")  else c("sampleNames", "sampleColumns")
##        new("AnnotatedDataFrame", data = data, dimLabels = dimLabels)
##    }
##}