R/getSNPplots.R

getSNPplots<-function(x, individuals=NULL, rotate=TRUE, col.fun='SNP') {

	require('GMD')
	require('fastcluster')
	require('GenomicRanges')
  tmp <- matrix()
  if(is(x, 'SummarizedExperiment')) {
    probes <- grep('^rs', names(rowData(x)))
    snps <- grep('^rs', names(rowData(x)), val=T)
	  tmp <- assays(x, withDimnames=F)[[1]][ probes, ] # getTNtype(x)=="01"]? 
  } 
  if(nrow(tmp) < 2) {
    stop('Need a SummarizedExperiment with SNP (rsXX) probes...none were found')
  }
  tmp = round(tmp*2)
  if(is.null(individuals)) individuals = dim(x)[2]
  SNP <- colorRampPalette(c('blue','yellow','red'))
  bw <- colorRampPalette(c('white','gray','black'))
  heading <- paste('SNP probes for', individuals, 'individuals')
  if(rotate) {
	  capture.output({ # {{{
  	  clusts <- suppressWarnings(heatmap.3(t(tmp), scale="none", trace="none", 
                                 color.FUN=get(col.fun), dendrogram='none', 
                                 labCol=snps, kr=individuals, Colv=T, Rowv=T, 
                                 labRow=colnames(x), main=heading))
      clusts$clusters <- clusts$row.clusters
      clusts$ind <- clusts$rowInd
    }) # }}}
  } else { 
	  capture.output({ # {{{
  	  clusts <- suppressWarnings(heatmap.3(tmp, scale="none", trace="none", 
                                 color.FUN=get(col.fun), dendrogram='none', 
                                 labRow=snps, kc=individuals, Colv=T, Rowv=T, 
                                 labCol=colnames(x), main=heading))
      clusts$clusters <- clusts$col.clusters
      clusts$ind <- clusts$colInd
    }) # }}}
  }
  individual <- clusts$clusters
  individual[clusts$ind] <- individual
  individual <- as.factor(individual)
  message('Assigned identity for each sample:')
  return(individual)
}
ttriche/regulatoR documentation built on June 1, 2019, 2:51 a.m.