.packageName <- "snm"
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/buildBasisFunction.R"

buildBasisFunction <-
		function(snm.obj) 
{
  lower <- min(rowMeans(snm.obj$dat))
  upper <- max(rowMeans(snm.obj$dat))
  basisSplineFunction <- ns(seq(lower,upper,length=100), df = snm.obj$spline.dim, 
      Boundary.knots = c(lower - 1, upper + 1),intercept=TRUE)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/buildBasisSplineMatrix.R"
buildBasisSplineMatrix <-
  	function(M, basisSplineFunction) 
{
  lnp <- dim(M)[1]
  bSM <- apply(M, 2, function(x) {
    		predict(basisSplineFunction, x)
  		})
  bSM.model <- sapply(1:(dim(basisSplineFunction)[2]), function(x) {
    		pos <- (x - 1) * lnp + 1
    		as.numeric(bSM[pos:(pos + lnp - 1), ])
  		})
  colnames(bSM.model) <- paste("Bt", 1:dim(bSM.model)[2], sep = "")
  bSM.model
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/calcArrayEffects.R"
calcArrayEffects <-
  	function(rff, basisSplineFunction, snm.obj, model.objects, M.matrix,lf) 
{
  offset <- 1;
  rfx <- list();
  for(i in 1:ncol(snm.obj$int.var)) { 
    rfx[[i]] <- matrix(rff@ranef[offset:(-1 + offset + nrow(lf$FL$trms[[i]]$Zt))], nr=length(unique(snm.obj$int.var[,i])))
    offset <- offset + nrow(lf$FL$trms[[i]]$Zt)
  }  
  ars <- sapply(1:ncol(M.matrix), function(i) {
    		mREFs <- sapply(1:length(rfx), function(j) {
      				model.objects$F.mats[[j]][i, ] %*% rfx[[j]]
    				})
    		bSM <- predict(basisSplineFunction, M.matrix[, as.numeric(i)])
    		arsL <- bSM %*% mREFs
    		rowSums(arsL)
  		})
  ars
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/calculate.nulls.R"
calculate.nulls <-
  	function(pvals, pi0) {
  which(rank(pvals) > (1-pi0)*length(pvals))
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/edge.fit.R"
edge.fit = function(edge.obj,odp=FALSE) {
  #Function by John Storey for the edge package
  
  err.func = "edge.fit"
  
  dat = edge.obj$dat
  n = edge.obj$n.arrays
  xx0 = edge.obj$adj.var
  df0 = edge.obj$df.null
  if(!odp) {
    xx1 = cbind(edge.obj$adj.var, edge.obj$bio.var)
  } else {
    xx1 = edge.obj$bio.var
  }
  df1 = edge.obj$df.full
  
  if(!is.null(edge.obj$ind)) {
    xxi = edge.obj$ind
    Hi = xxi %*% solve(t(xxi) %*% xxi) %*% t(xxi)
    fit.ind = t(Hi %*% t(dat))
    dat = dat - fit.ind
    xx1 = xx1 - Hi %*% xx1
    xx0 = xx0 - Hi %*% xx0
    xx1 = rm.zero.cols(xx1)
    xx0 = rm.zero.cols(xx0)
  }
  
  H0 = xx0 %*% solve(t(xx0) %*% xx0) %*% t(xx0)
  fit0 = t(H0 %*% t(dat))
  res0 = dat - fit0
  
  if(odp) {
    xx1 = xx1 - H0 %*% xx1
    H1 = xx1 %*% solve(t(xx1) %*% xx1) %*% t(xx1)
    fit1 = t(H1 %*% t(res0))
    res1 = res0-fit1
    var1 = rowSums(res1^2)/(n-df1)
    var0 = rowSums(res0^2)/(n-df0)
    return(list(fit1=fit1, fit0=fit0, res1=res1, res0=res0, var1=var1, var0=var0, ind=edge.obj$ind, odp=odp))
  } else {
    H1 = xx1 %*% solve(t(xx1) %*% xx1) %*% t(xx1)
    fit1 = t(H1 %*% t(dat))
    res1 = dat - fit1
    return(list(fit0=fit0, res1=res1, res0=res0, ind=edge.obj$ind, odp=odp))
  }
  
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/edge.glr.R"
edge.glr = function(obs.fit, df1, df0, norm.pval=FALSE) {
  #Function by John Storey for the edge package
  err.func = "edge.glr"
	
  res1 = obs.fit$res1
  res0 = obs.fit$res0
  
  n = ncol(res1)
  
  rss1 = apply(res1, 1, function(x) {sum(x^2)})
  rss0 = apply(res0, 1, function(x) {sum(x^2)})
	
  stat = ((rss0 - rss1)/(df1-df0))/(rss1/(n-df1))
	
  if(norm.pval) {
    pval = 1 - pf(stat, df1=(df1-df0), df2=(n-df1))
    return(list(stat=stat, pval=pval))
  } else {
    return(list(stat=stat, pval=NULL))
  }
	
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/edge.qvalue.R"
edge.qvalue <- function(p,lambda = seq(0, 0.9, 0.05), pi0.method = "smoother",
    fdr.level = NULL, robust = FALSE,smooth.df = 3, smooth.log.pi0 = FALSE, ...) {
  #Function by John Storey for the edge package
	
  err.func <- "edge.qvalue"
  if (min(p) < 0 || max(p) > 1) {
    err.msg(err.func,"P-values not in valid range.")
    return(invisible(1))
  }
  if (length(lambda) > 1 && length(lambda) < 4) {
    err.msg(err.func,"If length of lambda greater than 1, you need at least 4 values.")
    return(invisible(1))
  }
  if (length(lambda) > 1 && (min(lambda) < 0 || max(lambda) >= 1)) {
    err.msg(err.func,"Lambda must be in [0,1).")
    return(invisible(1))
  }
  m <- length(p)
  if (length(lambda) == 1) {
    if (lambda < 0 || lambda >= 1) {
      err.msg(err.func,"Lambda must be in [0,1).")
      return(invisible(1))
    }
    pi0 <- mean(p >= lambda)/(1 - lambda)
    pi0 <- min(pi0, 1)
  } else {
    pi0 <- rep(0, length(lambda))
    for (i in 1:length(lambda)) {
      pi0[i] <- mean(p >= lambda[i])/(1 - lambda[i])
    }
    if (pi0.method == "smoother") {
      if (smooth.log.pi0){ 
        pi0 <- log(pi0)
        spi0 <- smooth.spline(lambda, pi0, df = smooth.df)
        pi0 <- predict(spi0, x = max(lambda))$y
      }
      if (smooth.log.pi0) {
        pi0 <- exp(pi0)
      }
      pi0 <- min(pi0, 1)
    }
    else if (pi0.method == "bootstrap") {
      minpi0 <- min(pi0)
      mse <- rep(0, length(lambda))
      pi0.boot <- rep(0, length(lambda))
      for (i in 1:100) {
        p.boot <- sample(p, size = m, replace = TRUE)
        for (i in 1:length(lambda)) {
          pi0.boot[i] <- mean(p.boot > lambda[i])/(1 - lambda[i])
        }
        mse <- mse + (pi0.boot - minpi0)^2
      }
      pi0 <- min(pi0[mse == min(mse)])
      pi0 <- min(pi0, 1)
    }
    else {
      err.msg(err.func,"'pi0.method' must be one of 'smoother' or 'bootstrap'")
      return(invisible(1))
    }
  }
  if (pi0 <= 0) {
    err.msg(err.func,"The estimated pi0 <= 0. Check that you have valid\np-values or use another lambda method.")
    return(invisible(1))
  }
  if (!is.null(fdr.level) && (fdr.level <= 0 || fdr.level > 1)) {
    err.msg(err.func,"'fdr.level' must be within (0,1].")
    return(invisible(1))
  }
  u <- order(p)
	
  qvalue.rank <- function(x) {
    idx <- sort.list(x)
    fc <- factor(x)
    nl <- length(levels(fc))
    bin <- as.integer(fc)
    tbl <- tabulate(bin)
    cs <- cumsum(tbl)
    tbl <- rep(cs, tbl)
    tbl[idx] <- tbl
    return(tbl)
  }
  v <- qvalue.rank(p)
  qvalue <- pi0 * m * p/v
  if (robust) {
    qvalue <- pi0 * m * p/(v * (1 - (1 - p)^m))
  }
  qvalue[u[m]] <- min(qvalue[u[m]], 1)
  for (i in (m - 1):1) {
    qvalue[u[i]] <- min(qvalue[u[i]], qvalue[u[i + 1]], 1)
  }
  if (!is.null(fdr.level)) {
    retval <- list(call = match.call(), pi0 = pi0, qvalues = qvalue, pvalues = p, fdr.level = fdr.level, significant = (qvalue <= fdr.level), lambda = lambda)
  }
  else {
    retval <- list(call = match.call(), pi0 = pi0, qvalues = qvalue, pvalues = p, lambda = lambda)
  }
  class(retval) <- "qvalue"
  return(retval)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/err.msg.R"
err.msg <- function(err.func = "edge",msg) {
  cat('\n')
  cat('\t')
  cat('ERROR in the',err.func,'function: ','\n')
  cat('\t',msg,'\n\n')
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/fit.model.R"
fit.model <-
	function(obs.fit, snm.obj, basisSplineFunction)
{
  snm.obj$M <- snm.obj$dat - obs.fit$res1
  snm.obj$M[snm.obj$nulls,] <- obs.fit$fit0[snm.obj$nulls,]
	
# Split the data into nbins bins based on their mean intensities
  bins <- getSpanningSet(snm.obj)
  
# Build the matrix of weighted raw data and matrix of weighted fitted values for each bin.
  lnp <- length(bins)
  np <- 1:lnp
  Y.pooled <- 0*snm.obj$dat[np,]
  M.pooled <- 0*snm.obj$M[np,]
  for(i in 1:lnp) {
    Y.pooled[i,] = apply(matrix(snm.obj$r.dat[as.vector(bins[[i]]),], ncol=ncol(snm.obj$dat)),2,
        weighted.mean, w=snm.obj$weights[as.vector(bins[[i]])])
    M.pooled[i,] = apply(matrix(snm.obj$M[as.vector(bins[[i]]),], ncol=ncol(snm.obj$M)),2,
        weighted.mean, w=snm.obj$weights[as.vector(bins[[i]])])
  }
  
# Build the basis spline matrix for the pooled coefficients.
  bSM.model <- buildBasisSplineMatrix(M.pooled, basisSplineFunction)
  exp <- new.env()
# Build the data object and fit the mixed effects model
  expObj <- makeDataObject(Y.pooled, np, snm.obj, exp,bins)
  expObj$sp <- as.matrix(bSM.model)
  model.objects <- make.ref.model.matrices(snm.obj, exp)
  
  lf <- do.call("lmer", list(model.objects$ZF, expObj, NULL,TRUE,list(),NULL,FALSE, FALSE,1:nrow(expObj),expObj$weights))
  for(i in 1:ncol(snm.obj$int.var)) { 
    lf$FL$trms[[i]]$ST <- matrix(0,nr=1,nc=1)
    rownames(lf$FL$trms[[i]]$ST) <- colnames(lf$FL$trms[[i]]$ST) <- paste("spline",i,sep="")
  }
  rff <- do.call(lme4:::lmer_finalize,lf)
	
# Add useful variables to snm.obj
  snm.obj$E.pooled <- matrix(rff@resid, nr=dim(Y.pooled)[1])
  snm.obj$Y.pooled <- Y.pooled
  snm.obj$M.pooled <- M.pooled
  snm.obj$rff <- rff@ranef
  snm.obj$bin.densities <- sapply(bins,length)
  
  snm.obj$array.fx <- calcArrayEffects(rff, basisSplineFunction, snm.obj, model.objects, snm.obj$M, lf)
  return(snm.obj)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/fitted.snm.R"
snm.fitted <- function(object, ...) {

  if(object$rm.adj) {
    stop("This function is not permitted when rm.adj=TRUE.")
  }

  if(is.null(object$bio.var)) {
    stop("This function is not permitted when bio.var=NULL.")
  }
  
  edge.obj = list(dat=object$norm.dat, bio.var=object$bio.var,
    adj.var=object$adj.var, df.full=object$df1, df.null=object$df0,
    n.arrays=ncol(object$norm.dat), ind=NULL)
  class(edge.obj) = "edge"
  snm.fit = edge.fit(edge.obj, odp=FALSE)
  fit1 = object$norm.dat - snm.fit$res1
  fit0 = snm.fit$fit0

  ret.val = list(fit0=fit0, fit1=fit1)
  return(ret.val)

}

fitted.snm <- function(object, ...) {
  snm.fitted(object, ...)
}

#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/getSpanningSet.R"
getSpanningSet <-
		function(snm.obj) {
  m <- rowMeans(snm.obj$M[snm.obj$nulls,])
  steps <- seq(quantile(snm.obj$M[snm.obj$nulls,],0.001),
      quantile(snm.obj$M[snm.obj$nulls,],0.999), length.out=snm.obj$nbins)
  th <- sapply(m, function(x) { 
    		sum(x <= steps)
  		}) 
  bins <- split(snm.obj$nulls, th)
  bins
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/make.ref.model.matrices.R"
make.ref.model.matrices <-
		function(snm.obj, exp) 
{
  F.mats <- list()
  spline.re.model <- ""
  for (i in 1:length(snm.obj$int.var)) {
    ide <- names(snm.obj$int.var)[i]
    spline.re.model <- paste(spline.re.model, "+ ( sp -1 | ", ide, ")", sep = "")
    F.mats[[i]] <- model.matrix(~-1 + snm.obj$int.var[,i])
  }
  if (dim(snm.obj$adj.var)[2] > 0) {
    ref.model <- paste( "probes+", paste("probes:", colnames(snm.obj$adj.var)[-1],collapse = "+"),sep="+" )
  }
  else {
    ref.model <- "probes + "
  }
  ref.model <- as.formula(paste("y ~ -1 +", ref.model, spline.re.model), 
      env = exp)
  names(F.mats) <- names(snm.obj$int.var)
  list(ZF = ref.model, F.mats = F.mats)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/make.snm.obj.R"
make.snm.obj <-
		function(Y, bio.var, adj.var,int.var, spline.dim, nbins, weights=NULL, diagnose, rm.adj)
{
  if(!is.matrix(Y)) {
    stop("Y must be a matrix.")
  }

  if(!is.null(bio.var)) {
    if(is.data.frame(bio.var)) {
      bio.temp = NULL
      for(i in 1:ncol(bio.var)) {
        bio.temp = cbind(bio.temp, model.matrix(~bio.var[,i])[,-1])
      }
      bio.var = bio.temp
    }
    if(!is.matrix(bio.var)) {
      stop("bio.var must be a matrix.")
    }
    if(nrow(bio.var)!=ncol(Y)) {
      stop("The dimensions of Y and bio.var are incompatible. Please correct these objects.")
    }
    bio.var = cbind(bio.var[,!apply(bio.var, 2, function(x) {length(unique(x))==1})])
    if(ncol(bio.var)==0) {
      stop("bio.var must have at least one column (that is not an intercept term).")
    }
  }
  
  if(is.null(adj.var)) { 
    adj.var = cbind(rep(1,ncol(Y)))
  }
  if(is.data.frame(adj.var)) {
    adj.temp = NULL
    for(i in 1:ncol(adj.var)) {
      adj.temp = cbind(adj.temp, model.matrix(~adj.var[,i])[,-1])
    }
    adj.var = adj.temp
  }
  if(!is.matrix(adj.var)) {
    stop("adj.var must be a matrix.")
  }
  if(nrow(adj.var)!=ncol(Y)) {
    stop("The dimensions of Y and adj.var are incompatible. Please correct these objects.")
  }
  adj.var = cbind(rep(1,ncol(Y)), adj.var[,!apply(adj.var, 2, function(x) {length(unique(x))==1})])

  if(!is.null(int.var)) {
    if(is.vector(int.var)) {int.var = data.frame(as.factor(int.var))}
    if(is.matrix(int.var)) {
      int.var.temp = data.frame(as.factor(int.var[,1]))
      if(ncol(int.var)>1) {
        for(i in 2:ncol(int.var)) {
          int.var.temp = data.frame(int.var.temp, as.factor(int.var[,i]))
        }
      }
      if(!is.null(dimnames(int.var)[[2]])) {dimnames(int.var.temp)[[2]] = dimnames(int.var)[[2]]}
      int.var = int.var.temp
    }
    if(!is.data.frame(int.var)) {
      stop("int.var must be a data frame")
    }
    for(i in 1:ncol(int.var)) {
      if(!is.factor(int.var[,i])) {
        stop("Each column of int.var must be a factor variable.")
      }
    }
  }

  xx = try(solve(t(adj.var)%*%adj.var), silent=TRUE)
  if(is.character(xx)) {
    stop("adj.var is not a valid model matrix. Enter '?model.matrix' for more information on building a model matrix.")
  }
  yy = try(solve(t(cbind(bio.var,adj.var))%*%cbind(bio.var,adj.var)), silent=TRUE)
  if(is.character(yy)) {
    stop("cbind(bio.var,adj.var) is not a valid model matrix. Enter '?model.matrix' for more information on building a model matrix.")
  }
  
  dimnames.adj = dimnames(adj.var)
  dimnames(adj.var) = list(dimnames(adj.var)[[1]], paste("A", 1:ncol(adj.var), sep="")) 
  dimnames.bio = dimnames(bio.var)
  if(!is.null(bio.var)) {dimnames(bio.var) = list(dimnames(bio.var)[[1]], paste("B", 1:ncol(bio.var), sep=""))} 
  
  snm.obj = list()
  snm.obj$n.arrays = ncol(Y)
  snm.obj$n.probes = nrow(Y)
  snm.obj$rm.adj = rm.adj
  snm.obj$bio.var = bio.var
  snm.obj$adj.var = adj.var
  if(!is.null(bio.var)) {
    snm.obj$df.full = ncol(bio.var) + ncol(adj.var)
  } else {
    snm.obj$df.full = ncol(adj.var)
  }
  snm.obj$df.null = ncol(adj.var)
  snm.obj$int.var = int.var
  snm.obj$individuals = NULL
  snm.obj$spline.dim = spline.dim
  snm.obj$nbins = nbins
  snm.obj$diagnose = diagnose
  snm.obj$dat=Y
  if(is.null(weights)) {weights <- rep(1,nrow(Y))}
  snm.obj$weights=weights
  snm.obj$r.dat=Y
  snm.obj$dimnames.adj = dimnames.adj
  snm.obj$dimnames.bio = dimnames.bio
  class(snm.obj) = "edge"
  return(snm.obj)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/makeDataObject.R"
makeDataObject <-
		function(Y.pooled, np, snm.obj, exp,bins) 
{
  lnp <- length(np)
  num.arrays <- dim(Y.pooled)[2]
  signal <- data.frame(y = as.numeric(Y.pooled), 
      probes = factor(rep(1:lnp, times = num.arrays)))
  f <- lapply(1:length(snm.obj$int.var), function(x) {
    		i <- snm.obj$int.var[, x]
    		rep(i, each = lnp)
  		})
  f <- as.data.frame(f)
  colnames(f) <- names(snm.obj$int.var)
  if (ncol(snm.obj$adj.var) > 1) {
    z <- lapply(2:(ncol(snm.obj$adj.var)), function(x) {
      		i <- snm.obj$adj.var[, x]
      		rep(i, each = lnp)
    		})
    z <- as.data.frame(z)
    colnames(z) <- colnames(snm.obj$adj.var)[-1]
    df <- cbind(cbind(signal, z), f)
  }else {
    df <- cbind(signal, f)
  }
  df$weights = sapply(bins,length) / 50 #mean(sapply(bins,length))
  df$weights[df$weights >1] <- 1
  TMP <- sapply(1:dim(df)[2], function(x) {
    		assign(colnames(df)[x], df[, x], envir = exp)
  		})
  as.data.frame(df)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/plot.snm.R"
snm.plot <- function(x, col.by=NULL, ...) {

  #Process col.by argument, which is used for array effects only
  if(is.null(col.by)) {
    col.by = rep(1,ncol(x$M))
  } else {
    if(is.matrix(col.by)) {
      if(ncol(col.by)==1) {
        col.by = as.vector(col.by)
      } else if(!all(as.vector(col.by)==0 + (as.vector(col.by)==1))) {
        stop("If col.by is a matrix, then it can only take values 0 or 1.")
      } else {
        col.by = drop(col.by %*% (1:ncol(col.by)))
      }
    }
    col.by = as.factor(col.by)
    k = length(levels(col.by))
    col.by = drop(model.matrix(~-1+col.by) %*% (1:k))
    if(k < 4) {
      col.by = c("red", "blue", "green")[col.by]
    } else {
      col.by = rainbow(k)[col.by]
    }
  }
  
  if(is.null(x$bio.var) && !is.null(x$int.var)) {
    plot(x$M[,1], x$array.fx[,1], type="l", lwd=1, xlim=range(x$M), ylim=range(x$array.fx), col=col.by[1],
         xlab="Estimated Intensity", ylab="Estimated Effect by Array",main="Intensity-Dependent Effects")
    for(i in 2:dim(x$M)[2]) {
      points(x$M[,i], x$array.fx[,i],type="l", col=col.by[i])
    }
  } else {
  
    par(mfrow=c(2,2), oma=c(1,0,2,0))
    
  #Plot A
    pi0.diffs = x$iter.pi0s - x$pi0 
    plot(pi0.diffs, pch=19, ylim=c(-max(abs(pi0.diffs)), max(abs(pi0.diffs))),
         xlab="Iteration", ylab="pi0.iteration - pi0.final", main="Convergence")
    abline(h=0, lty=2)

  #Plot B
    if(x$rm.adj) {
      plot(0, 0, xlab=" ", ylab=" ", main="Latent Structure", pch=" ")
      warning("It is not possible to plot latent structure when rm.adj=TRUE.")
    } else {
      res1 <- x$norm.dat - fitted(x)$fit1
      u <- fast.svd(res1,tol=0)
      plot(100*u$d^2 / sum(u$d^2), ylim=c(0,100), pch=19,
           main="Residual Latent Structure",
           xlab="Principal Component",
           ylab="Percent Variation Explained")
    }
        
  #Plot C
    if(is.null(x$M)) {
      plot(0, xlab=" ", ylab=" ", main="Intensity-Dependent Effects")
      warning("No intensity-dependent effects were estimated.")
    } else {
      plot(x$M[,1], x$array.fx[,1],
           type="l", lwd=1, xlim=range(x$M), ylim=range(x$array.fx), col=col.by[1],
           xlab="Estimated Intensity", ylab="Estimated Effect by Array",main="Intensity-Dependent Effects")
      for(i in 2:dim(x$M)[2]) {
        points(x$M[,i], x$array.fx[,i],type="l", col=col.by[i])
      }
    }
  
  #Plot D
    hist(x$pval, xlab="P-values",main="P-value Distribution", freq=FALSE)
    abline(v=min(x$pval[x$nulls]),col="red")
    pi0 = round(x$pi0,3)
    abline(h=pi0, lty=3)
    mtext(substitute(hat(pi)[0] == that, list(that=pi0)))

    #Overall Title
    title("SNM Diagnostic Plot", outer=TRUE)
  }

}

plot.snm <- function(x, ...) {
  snm.plot(x, ...)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/removeAdjustmentsVars.R"
remove.adjustment.vars <- function(snm.obj) {
  dat = snm.obj$dat
  n = snm.obj$n.arrays
  xx0 = snm.obj$adj.var
  df0 = snm.obj$df.null
  xx1 = cbind(snm.obj$adj.var, snm.obj$bio.var)
  P1 = solve(t(xx1) %*% xx1) %*% t(xx1)
  cfs1 = t(P1 %*% t(dat))
  res1 = dat - cfs1 %*% t(xx1)
  x1 <- cbind(rep(1,dim(dat)[2]), snm.obj$bio.var)
  if(ncol(snm.obj$adj.var) > 1) {
    cfs2 <- cfs1[, -(2:ncol(snm.obj$adj.var))]
  }else{
    cfs2 <- cfs1
  }
  fit1 <- cfs2 %*% t(x1)
  snm.obj$dat <- fit1 + res1
  snm.obj
}

#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/rm.zero.cols.R"
rm.zero.cols = function(xx, eps=10^(-12)) {
  n = ncol(xx)
  vv = NULL
  for(i in 1:n) {
    if(sum(abs(xx[,i])) < eps) {
      vv = c(vv, i)
    }
  }
  if(is.null(vv)) {
    return(xx)
  } else {
    return(xx[,-vv])
  }
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.doubleChannel.R"
sim.doubleChannel <- function(seed) { 
  set.seed(seed)
  np <- 25000
  na <- 20
  gmeans <- rchisq(np,1,2)
  gmeans[gmeans>15] <- runif(sum(gmeans>15),15,16)
  data <- matrix(gmeans,nr=np,nc=na)
  bio.var <- data.frame(groups=rep(c("A","B"),each=10))
  adj.var <- data.frame(height=rnorm(20,1,0.5))
  int.var <- data.frame(array=factor(c(1:10,1:10)), dye=factor(rep(c("CY3","CY5","CY5","CY3"),each=5)))
  retBio<-FALSE
  
  group.effect <- sim.probe.specific(data, bio.var$groups, 0.3, list(func=rnorm,params=c(mean=1,sd=0.3)))
  height.effect <- sim.probe.specific(data, adj.var$height, 0.2, list(func=rnorm, params=c(mean=1,sd=0.1)))
  
  M <- data + group.effect + height.effect
  
  array.effect <- sim.intensity.dep(M, int.var$array, 2, list(func=rnorm, params=c(mean=0,sd=1)))
  dye.effect <- sim.intensity.dep(M, int.var$dye, 2, list(func=rnorm, params=c(mean=0,sd=1)))
  E <- matrix(rnorm(length(data),0,0.25), nr=nrow(data), nc=ncol(data))
  Y <- M + array.effect + dye.effect + E
  
  true.nulls <- which(group.effect[,1] == group.effect[,11])
  ret.obj <- 
    	list(raw.data=Y, 
          bio.var=model.matrix(~groups,data=bio.var),
          adj.var=model.matrix(~height,data=adj.var),
          int.var=int.var,
          true.nulls=true.nulls)
  ret.obj
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.function.var.R"
sim.function.var <- function(data=NULL,variable=NULL,rows=NULL, sample.from=NULL, spline.dim=NULL) {
	
#  Make certain class of variable is numeric
  if(class(variable) != "numeric" & class(variable) != "integer") { 
    stop("Class of variable must be numeric.")
  }
  
  Z <- ns(variable, df=spline.dim)
# Handle the rows variable.  If its a single number, then its a proportion.  Otherwise, its a vector of probe indices to be modified.
  lab <- rep(0, nrow(data))  # Create vector of dummy variables    
  if(length(rows)==1) {
    if(rows > 1) { stop("Proportion of data to be influenced by variable greater than 1.")}
    these <- sample(1:nrow(data), nrow(data) * rows) # Sample rows to be modified
    lab[these] <- 1  #Identify rows to be modified
  }else{
    if(max(rows) > nrow(data)) { stop("At least one row of data matrix to be influenced by variable is larger than total number of rows in data")}
    if(min(rows) < 0) { stop("Rows to be influenced by variable must be greater than 0")}
    lab[rows] <- 1  # Identify rows to be modified
  }
  
  x <- model.matrix(~-1+Z)  # Create model matrix for variable
  sample.this.many <- sum(lab==1) * ncol(x)  # Count how many probes to be modified
  cfs <- matrix(0, nr=length(lab), nc=ncol(x))  #Initialize matrix of coefficients
  
  if(is.list(sample.from)) {
    for(spd in 1:length(sample.from)) { 
      # Estimate coefficients and add to coefficients matrix
      cfs[which(lab==1),spd] <- do.call(sample.from[[spd]]$func, as.list(c(n=sum(lab==1), sample.from[[spd]]$params)))
    }
  }else{
    stop("Spline coefficients must be a list")
  }
  
  cfs.mat <- cfs %*% t(x)  #  Estimate overall effect
  t(apply(cfs.mat,1,function(x) {  #Make all positive.  Don't want streaks in scatter plots
    				if(min(x) < 0) {
      				x - min(x)
    				}else{
      				x
    				}
  				})) -> cfs.mat
  cfs.mat  # Return effects
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.intensity.dep.R"
sim.intensity.dep <- function(data=NULL,variable=NULL,spline.dim=NULL,sample.from=NULL, rows=1) {
	
#  Make certain only a single variable was passed
  if(class(variable) != "character" & class(variable) != "factor") { 
    stop("Variable not valid.  Must be a character or factor.")
  }
  
#Make any character a factor
  if(class(variable)=="character") {
    variable <- as.factor(variable)
  }
  
# Handle the rows variable.  If its a single number, then its a proportion.  Otherwise, its a vector of probe indices to be modified.
  if(rows!=1) { 
    lab <- rep(0, nrow(data))  # Create vector of dummy variables    
    if(length(rows)==1) {
      if(rows > 1) { stop("Proportion of data to be influenced by variable greater than 1.")}
      these <- sample(1:nrow(data), nrow(data) * rows) # Sample rows to be modified
      lab[these] <- 1  #Identify rows to be modified
    }else{
      if(max(rows) > nrow(data)) { stop("At least one row of data matrix to be influenced by variable is larger than total number of rows in data")}
      if(min(rows) < 0) { stop("Rows to be influenced by variable must be greater than 0")}
      lab[rows] <- 1  # Identify rows to be modified
    }
  }else{
    lab=rep(1,nrow(data))
  }
  
  x <- model.matrix(~-1+variable)  # Create model matrix for variable
  z <- ns(seq(min(data),max(data),length=100), df=spline.dim, Boundary.knots=c(min(data)-1,max(data)+1))
  cfs.mat <- 0 * data
  spline.coefficients <- matrix(0,nr=ncol(x), nc=spline.dim)
  for(i in 1:ncol(x)) { 
    spline.coefficients[i,] <- do.call(sample.from$func, as.list(c(n=ncol(z), sample.from$params)))
  }
  for(i in 1:ncol(data)) { 
    spline.evals <- predict(z,data[,i])
    cfs.mat[,i] <- spline.evals %*% spline.coefficients[which(x[i,]==1),]
  }
  cfs.mat <- lab * cfs.mat
  cfs.mat  # Return coefficients
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.preProcessed.R"
sim.preProcessed <- function(seed) { 
  set.seed(seed)
  np <- 25000
  na <- 50
  gmeans <- rchisq(np,1,2)
  gmeans[gmeans>15] <- runif(sum(gmeans>15),15,16)
  data <- matrix(gmeans,nr=np,nc=na)
  bio.var <- data.frame(groups=rep(c("A","B"),each=25))
  adj.var <- data.frame(batches=rep(c("A","B","C","D","E"),times=10),
      height=rnorm(50,1,0.5))
  int.var <- NULL
  
  group.effect <- sim.probe.specific(data, bio.var$groups, 0.3, list(func=rnorm,params=c(mean=1,sd=0.3)))
  batches.effect <- sim.probe.specific(data, adj.var$batches, 0.1, list(func=rnorm,params=c(mean=0,sd=0.3)))
  height.effect <- sim.probe.specific(data, adj.var$height, 0.2, list(func=rnorm, params=c(mean=1,sd=0.1)))
  
  M <- data + group.effect + batches.effect + height.effect
  
  E <- matrix(rnorm(length(data),0,0.25), nr=nrow(data), nc=ncol(data))
  Y <- M + E
  true.nulls <- which(group.effect[,1] == group.effect[,26])
  
  ret.obj <- 
    	list(raw.data=Y, 
          bio.var=model.matrix(~groups,data=bio.var),
          adj.var=model.matrix(~batches+height,data=adj.var),
          int.var=int.var,
          true.nulls=true.nulls)
  ret.obj
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.probe.specific.R"
sim.probe.specific <- function(data=NULL,variable=NULL,rows=NULL,sample.from=NULL) {  
	
#  Make certain only a single variable was passed
  if(class(variable) != "character" & class(variable) != "numeric" & class(variable) != "factor") { 
    stop("Variable not valid.  Must be a character, vector or factor.")
  }
	
#Make any character a factor
  if(class(variable)=="character") {
    variable <- as.factor(variable)
  }
	
# Handle the rows variable.  If its a single number, then its a proportion.  Otherwise, its a vector of probe indices to be modified.
  lab <- rep(0, nrow(data))  # Create vector of dummy variables    
  if(length(rows)==1) {
    if(rows > 1) { stop("Proportion of data to be influenced by variable greater than 1.")}
    these <- sample(1:nrow(data), nrow(data) * rows) # Sample rows to be modified
    lab[these] <- 1  #Identify rows to be modified
  }else{
    if(max(rows) > nrow(data)) { stop("At least one row of data matrix to be influenced by variable is larger than total number of rows in data")}
    if(min(rows) < 0) { stop("Rows to be influenced by variable must be greater than 0")}
    lab[rows] <- 1  # Identify rows to be modified
  }
  
  x <- model.matrix(~-1+variable)  # Create model matrix for variable
  sample.this.many <- sum(lab==1) * ncol(x)  # Count how many probes to be modified
  cfs <- matrix(0, nr=length(lab), nc=ncol(x))  #Initialize matrix of coefficient
  # If sample.from is a list, sample from the function and pass the parameters.
  if(is.list(sample.from)) {
    #Estimate coefficients and add to coefficients matrix 
    cfs[which(lab==1),] <- do.call(sample.from$func, as.list(c(n=sample.this.many, sample.from$params)))
  }else{
    stop("sample.from must be a list")
  }
  cfs.mat <- cfs %*% t(x)  #  Estimate overall effect
  t(apply(cfs.mat,1,function(x) {  #Make all positive.  Don't want streaks in scatter plots
    				if(min(x) < 0) {
      				x - min(x)
    				}else{
      				x
    				}
  				})) -> cfs.mat
  cfs.mat  # Return effects
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.refDesign.R"
sim.refDesign <- function(seed) { 
  set.seed(seed)
  np <- 25000
	na <- 40
	gmeans <- rchisq(np,1,2)
	gmeans[gmeans>15] <- runif(sum(gmeans>15),15,16)
	data <- matrix(gmeans,nr=np,nc=na)
	bio.var <- data.frame(groups=rep(c("A","B","C"),c(10,10,20)))
	adj.var <- NULL
	int.var <- data.frame(array=factor(c(1:20,1:20)), dye=factor(rep(c("CY3","CY5"),each=20)))
	
	group.effect <- sim.probe.specific(data, bio.var$groups, 0.3, list(func=rnorm,params=c(mean=1,sd=0.3)))
	
	M <- data + group.effect 
	
	array.effect <- sim.intensity.dep(M, int.var$array, 2, list(func=rnorm, params=c(mean=0,sd=1)))
	dye.effect <- sim.intensity.dep(M, int.var$dye, 2, list(func=rnorm, params=c(mean=0,sd=1)))
	E <- matrix(rnorm(length(M),0,0.25), nr=nrow(M), nc=ncol(M))
	Y <- M + array.effect + dye.effect + E
	
	true.nulls <- which(group.effect[,1] == group.effect[,11])
	ret.obj <- 
			list(raw.data=Y, 
					bio.var=model.matrix(~groups,data=bio.var),
					adj.var=NULL,
					int.var=int.var,
					true.nulls=true.nulls)
	ret.obj
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/sim.singleChannel.R"
sim.singleChannel <- function(seed) { 
  set.seed(seed)
  np <- 25000
  na <- 50
  gmeans <- rchisq(np,1,2)
  gmeans[gmeans>15] <- runif(sum(gmeans>15),15,16)
  data <- matrix(gmeans,nr=np,nc=na)
  bio.var <- data.frame(groups=rep(c("A","B"),each=25))
  adj.var <- data.frame(batches=rep(c("A","B","C","D","E"),times=10),
      height=rnorm(50,1,0.5))
  int.var <- data.frame(array=factor(1:50))
  
  group.effect <- sim.probe.specific(data, bio.var$groups, 0.3, list(func=rnorm,params=c(mean=1,sd=0.3)))
  batches.effect <- sim.probe.specific(data, adj.var$batches, 0.1, list(func=rnorm,params=c(mean=0,sd=0.3)))
  height.effect <- sim.probe.specific(data, adj.var$height, 0.2, list(func=rnorm, params=c(mean=1,sd=0.1)))
  
  M <- data + group.effect + batches.effect + height.effect
  
  array.effect <- sim.intensity.dep(M, int.var$array, 2, list(func=rnorm, params=c(mean=0,sd=1)))
  E <- matrix(rnorm(length(data),0,0.25), nr=nrow(data), nc=ncol(data))
  Y <- M + array.effect + E
  true.nulls <- which(group.effect[,1] == group.effect[,26])
  
  ret.obj <- 
    	list(raw.data=Y, 
          bio.var=model.matrix(~groups,data=bio.var),
          adj.var=model.matrix(~batches+height,data=adj.var),
          int.var=int.var,
          true.nulls=true.nulls)
  ret.obj
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/snm.R"
snm <-
	function(raw.dat, bio.var=NULL, adj.var=NULL, int.var=NULL,
                 weights=NULL, spline.dim = 4, num.iter = 10, nbins=50,
                 rm.adj=FALSE, verbose=TRUE, diagnose=TRUE)
{

  if(is.null(bio.var)) {
    warning("bio.var=NULL, so all probes will be treated as 'null' in the normalization.")
  }
  
  snm.obj <- make.snm.obj(Y=raw.dat, bio.var, adj.var, int.var, spline.dim,
      nbins, weights, diagnose, rm.adj)  

  if(!is.null(snm.obj$int.var)) {		  

    #Set up model fitting loop
    basisSplineFunction <- buildBasisFunction(snm.obj)
    
    #If bio.var=NULL, then only fit intensity-dependent effects
    if(is.null(snm.obj$bio.var)) { 
      snm.obj$pi0 <- 1
      snm.obj$nulls <- 1:snm.obj$n.probes
      obs.fit = list()
      xx0 = snm.obj$adj.var
      H0 = xx0 %*% solve(t(xx0) %*% xx0) %*% t(xx0)
      obs.fit$fit0 = t(H0 %*% t(snm.obj$dat))
      obs.fit$res1 = snm.obj$dat - obs.fit$fit0
      snm.obj <- fit.model(obs.fit, snm.obj, basisSplineFunction)
      snm.obj$dat <- snm.obj$r.dat - snm.obj$array.fx
      snm.obj$pi0s <- NULL
    } else {
    #Otherwise perform model fitting loop
      pi0s <- rep(0,num.iter)
      obs.fit <- edge.fit(snm.obj, odp=FALSE)
      for (i in 1:num.iter) {
        if(verbose){cat("\r", "Iteration: ", i)}
        obs.stat <- edge.glr(obs.fit, df1=snm.obj$df.full, df0=snm.obj$df.null, norm.pval=TRUE)
      	snm.obj$pi0 <- edge.qvalue(obs.stat$pval)$pi0
      	snm.obj$nulls <- calculate.nulls(obs.stat$pval, snm.obj$pi0)
        snm.obj <- fit.model(obs.fit, snm.obj, basisSplineFunction)
        snm.obj$dat <- snm.obj$r.dat - snm.obj$array.fx
      	obs.fit <- edge.fit(snm.obj, odp=FALSE)
      	if(diagnose) {
          snm.diagnostic.plot(obs.fit,obs.stat$pval,snm.obj,iter=i)
      	}
      	pi0s[i] <- snm.obj$pi0
      }
      snm.obj$pi0s <- pi0s
    }

    #Extract subset of array effects (to reduce size of return object)
    #Set seed before running snm if this needs to be reproduced
    if(dim(snm.obj$dat)[1] > (nbins*100)) {
      th <- sample(dim(snm.obj$dat)[1], (nbins*100))
    } else {
      th <- 1:dim(snm.obj$dat)[1]
    } 
    M.ret = snm.obj$M[th,]
    array.fx.ret = snm.obj$array.fx[th,]
    for(i in 1:ncol(M.ret)) {
      oo <- order(M.ret[,i])
      M.ret[,i] = M.ret[oo,i]
      array.fx.ret[,i] = array.fx.ret[oo,i]
    }

    #Get final model fit significance
    if(is.null(bio.var)) { 
      obs.stat <- NULL
      snm.obj$pval <- NULL
      snm.obj$pi0 <- NULL
    } else {
      obs.stat <- edge.glr(obs.fit, df1=snm.obj$df.full, df0=snm.obj$df.null, norm.pval=TRUE)
      snm.obj$pval <- obs.stat$pval
      snm.obj$pi0 <- edge.qvalue(obs.stat$pval)$pi0
      if(snm.obj$rm.adj){
      	snm.obj <- remove.adjustment.vars(snm.obj)
      }
    }
  } else {
    #No intensity-dep effects, so simply remove adjustment variables
    obs.fit <- edge.fit(snm.obj, odp=FALSE)
    obs.stat <- edge.glr(obs.fit, df1=snm.obj$df.full, df0=snm.obj$df.null, norm.pval=TRUE)
    if(!snm.obj$rm.adj) {
      stop("int.var=NULL and rm.adj=FALSE, so there is nothing to do.")
    }
    snm.obj <- remove.adjustment.vars(snm.obj)
    snm.obj$pval <- obs.stat$pval; 
    snm.obj$pi0s <- edge.qvalue(obs.stat$pval)$pi0
    snm.obj$pi0 <- snm.obj$pi0s
    M.ret = NULL
    array.fx.ret = NULL
  }

  dimnames(snm.obj$adj.var) = snm.obj$dimnames.adj
  dimnames(snm.obj$bio.var) = snm.obj$dimnames.bio
	
  snm.ret <- list(norm.dat=snm.obj$dat, pval=snm.obj$pval, pi0=snm.obj$pi0, iter.pi0s=snm.obj$pi0s, nulls=snm.obj$nulls,
                  M=M.ret, array.fx=array.fx.ret, bio.var=snm.obj$bio.var, adj.var=snm.obj$adj.var, int.var=snm.obj$int.var,
                  df1=snm.obj$df.full, df0=snm.obj$df.null, raw.dat=raw.dat, rm.adj=rm.adj, call = match.call())

  class(snm.ret) = "snm"
  return(snm.ret)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/snm.diagnosticPlot.R"
snm.diagnostic.plot <-
  function(obs.fit, pval, snm.obj, iter)
{
  par(mfrow=c(2,2), oma=c(1,0,2,0))
  bds <- ifelse(snm.obj$bin.densities > 500, 500, snm.obj$bin.densities)
  plot(rowMeans(snm.obj$M.pooled),
       bds,ylim=c(0,500), pch=19, yaxt="n",
       xlab="Estimated RNA Concentration", ylab="Probes per bin", main="Null Probes Per Bin")
  axis(side=2, at=500, label=" 500+")
  axis(side=2, at=c(0,100,200,300,400))
  
  u <- fast.svd(obs.fit$res1,tol=0)
  plot(100*u$d^2 / sum(u$d^2), ylim=c(0,100), pch=19,
       main="Residual Latent Structure",
       xlab="Principal Component",
       ylab="Percent Variation Explained")
  
  if(dim(snm.obj$dat)[1] > 5000) {
    th <- sample(dim(snm.obj$dat)[1], 5000)
  }else{
    th <- 1:dim(snm.obj$dat)[1]
  } 
  oo <- order(snm.obj$M[th,1])
  plot(snm.obj$M[th[oo],1], snm.obj$array.fx[th[oo],1],
       type="l",lwd=1, ylim=range(snm.obj$array.fx[th[oo],]),
       xlab="Estimated Intensity", ylab="Estimated Effect by Array",main="Intensity-Dependent Effects")
  sapply(2:dim(snm.obj$r.dat)[2],function(id) {
    oo <- order(snm.obj$M[th,id])
    points(snm.obj$M[th[oo],id], snm.obj$array.fx[th[oo],id],type="l")
  }) -> hmm
  
  hist(pval, xlab="P-values",main="P-value Distribution");
  abline(v=min(pval[snm.obj$nulls]),col="red")
  pi0 = round(snm.obj$pi0,3)
  mtext(substitute(hat(pi)[0] == that, list(that=pi0)))
  title(paste("SNM Diagnostic Iteration", iter, sep=" "), outer=TRUE)
}
#line 1 "E:/biocbld/bbs-2.8-bioc/tmpdir/RtmpzcLgCm/R.INSTALL5b566c1/snm/R/summary.snm.R"
snm.summary <- function(object, cuts=c(0.0001, 0.001, 0.01, 0.025, 0.05, 0.10, 1), ...) {

  cat('\n'); cat('SNM Data and Model Summary', '\n', '\n')
  cat('Total number of arrays:', ncol(object$norm.dat), '\n')
  cat('Total number of probes:', nrow(object$norm.dat), '\n', '\n')
  if(!is.null(object$bio.var)) {
    cat('Final estimated proportion of null probes: '); cat(round(object$pi0, 3)); cat('\n'); cat('\n') 
    cat("Cumulative number of significant calls:\n")
    qobj = edge.qvalue(object$pval, ...)
    counts = sapply(cuts, function(x) c("p-value"=sum(qobj$pvalues < x), "q-value"=sum(qobj$qvalues < x)))
    colnames(counts) = paste("<", cuts, sep="")
    print(counts)
    cat("\n")
    cat('Full model degrees of freedom:', object$df1, '\n')
    cat('Null model degrees of freedom:', object$df0, '\n', '\n')
    cat('Biological variables:', '\n'); print(signif(t(object$bio.var)), digits=3); cat('\n')
  }
  cat('Adjustment variables:', '\n'); print(signif(t(object$adj.var)), digits=3); cat('\n') 
  cat('Intensity-dependent variables:', '\n'); print(t(object$int.var)); cat('\n')
  cat('Function call:', '\n'); print(object$call)
  
}

summary.snm <- function(object, ...) {
  snm.summary(object, ...)
}
