/gqMicroarrays/R/report.r

#' This function ensures directories and css exist
#' 
#' @title Check dir existence for reporting
#' @param report.dir coming soon
#' @param data.dir coming soon
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export 
check.dirs <-function(report.dir,data.dir)
{
	# Prepare where the data will be written
	if(!file.exists(file.path(report.dir))) 
	{
		dir.create(file.path(report.dir))
	}


	files.dir = file.path(report.dir,"files")
	if(!file.exists(files.dir))
	{
			dir.create(files.dir)
	}

	#file.copy(data.dir,files.dir,recursive=TRUE)
	system(paste('cp -r ',data.dir,'/* ',files.dir,'/',sep=''))

	css.dir = file.path(files.dir,'css')
	rp.dir =system.file(file.path('templates','report_parts'),package = "gqMicroarrays")
	if(!file.exists(css.dir)) 
	{
		dir.create(css.dir)
		file.copy( file.path(rp.dir,'report.css'), file.path(css.dir)  )
		file.copy( file.path(rp.dir,'R2HTML.css'), file.path(css.dir)  )
		file.copy( file.path(rp.dir,'hwriter.css'), file.path(css.dir)  )
	}
}




#' This function fetches html bits need for report contruction
#' 
#' @title getHtmlBits
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export
getHtmlBits <-function(data.dir=NULL)
{	
	dir  = system.file(file.path('templates','report_parts')
			,package = "gqMicroarrays") 
	#dir = '~/github/local/Lef_AT_GenomeQuebec/gqMicroarrays/inst/templates/report_parts/'
	#warning('TEMP html bits for devel')	

	html = list(
	"head"             =  readLines(file.path(dir,'head.html'))
	,"annotations"     =  readLines(file.path(dir,'annotations.html'))
        ,"removals"        =  readLines(file.path(dir,'removals.html'))
	,"preprocessing"   =  readLines(file.path(dir,'preprocessing.html'))
	,"exploratory"     =  readLines(file.path(dir,'exploratory.html'))
	,"dgea"            =  readLines(file.path(dir,'dgea.html'))
	)
	return(html)	
}






#' QC and expl functions need similar input and this operation needs to be repeated often This is just a general function to 
#' turn an object into a matrix and rename it's columns.
#' @title Create report based on the content of the 'database'
#' @param path 
#' @author Lefebvre F
#' @export
createReport <- function(
		path=db.path,
		params = getParams(path),
		gene.sets.db.alias = params[['gene.sets.db.alias']],
		report.dir   = params[['report.dir']],
		report.title = params[['title']]
		#pdata   = getPdata(path),
		#eset  	= getEset(path),
		#fdata   = getFdata(params[["platform.alias"]]), 
		)
{
    # path=db.path	
	if(!is.null( gene.sets.db.alias ))
	{
		gene.sets = getGeneSets(gene.sets.db.alias,as.list = TRUE)				
	}else{gene.sets=NULL}

	# Prepare the report location
	check.dirs(report.dir, path)

	# Report Heading
	html = getHtmlBits(path)$head # report header
	html = gsub('TITLE',"Microarray Data Analysis",html) # Replace title
	html = gsub('PROJECT_NAME',report.title,html) # Replace project name
	html = gsub('TIMESTAMP',Sys.time(),html) # timestamp	
    	html = c(  html,report.annotations(path,report.dir=report.dir) )# The Annotations section
	html = c(  html,report.removals(path) )# Removals
	html = c(  html,report.preprocessing(path) )# preprocessing
	html = c(  html,report.exploratory(path) )# exploratory
	html = c(  html,report.dgea(path,report.dir=report.dir) )# differential	

	html = c(html,paste("<br><i>Analysis performed by ",params[['author']],", on ", format(Sys.time(), "%Y-%m-%d %X"),".</i>",sep='')) # report creation info

	# Report Tweaking
	pipeline.type = getSupportedPlatforms()[params[['platform.alias']],'pipeline.type']
	if( pipeline.type %in% c("methylation" , "MeDIP"))
	{
		html = gsub('expression','methylation',html)
	}
	
	writeLines(html,file.path(report.dir,"index.html"))

	# Copy markdown template to the current dir
#TEMP	md.fn  = system.file(file.path("templates",'report.Rmd'),package = "gqMicroarrays")
#	md.fn  = '~/github/local/Lef_AT_GenomeQuebec/gqMicroarrays/inst/templates/report.Rmd'# TODO TEMP TEMP for devel
#	file.copy(md.fn, '.', overwrite=TRUE)
	#########################
	##########################
 #   	knit2html("report.Rmd")
#	browseURL(file.path("report.html"))
	
	# Here we will make a copy of the data in a folder, without the .Rdata
#	dir.create(params[['report.dir']])
#	file.copy('report.html',file.path(params[['report.dir']],'report.html'),overwrite=TRUE)
#	file.copy(path,file.path(params[['report.dir']]),overwrite=TRUE,recursive=TRUE)	
	# TODO: figure out how not to copy .Rdata, or alt. just tar the result so as to not use too much space
#	# First, read the entire database to memory
}





#' report dgea
#' 
#' 
#' coming soon
#' 
#' @param report.dir coming soon
#' @param data.dir coming soon
#' @param dgea.items coming soon
#' @param dgea.params coming soon
#' @param third.id coming soon
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export
report.dgea <- function(path,report.dir){

	html = getHtmlBits()$dgea
	params  = getParams(path)
	fits = getFits(path) # blargh. This will be memory prohibitive with 450k I assure you. Function differential should write the necessary data as text beforehand.

	# Model name/description
	html = gsub( '_MODELNAME_', fits$model.name,html)
	# variables
	html = gsub('_VARIABLES_', paste(fits$variables,collapse=', '),html)
	# Replication
	# design
	write.csv(fits$design,file=file.path(report.dir,'files','differential','design.csv'),row.names=TRUE)
	# cont.matrix
	write.csv(fits$cont.matrix,file=
		file.path(report.dir,'files','differential','cont_matrix.csv'),row.names=TRUE)
	# full results file
	# Summary table
	summary = fits$summary.html	

	# case of GSEA or not.
        summary = fits$summary.html
	if(is.null(params[["gene.sets.db.alias"]])){summary[['Gene Sets/Pathways']]=NULL}
	html = gsub('_SUMMARY_',
		
		hwrite(summary,row.names=FALSE,br=TRUE,center=TRUE
			,row.bgcolor=c('#ffffaa',rep('#f1ecff',times=nrow(summary))))
				,html)	


	html = gsub(paste('href=\\"',path,sep=''),'href=\\"files',html)

	return(html)
}







#' 
#' 
#' coming soon
#' 
#' @param report.dir coming soon
#' @param data.dir coming soon
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export 
report.exploratory <- function(path)
{

	html = getHtmlBits(data.dir)$exploratory
	load(file.path(path,'exploratory','index.RData'))
	expl.figs = index$index.html
	expl.figs$File = gsub(paste('\\"',path,sep=''),'\\"files',expl.figs$File)

	html = gsub('_EXPLORATORYTABLE_'
		,hwrite(expl.figs,row.names=FALSE,br=TRUE,center=TRUE
			,row.bgcolor=c('#ffffaa',rep('#f1ecff',times=nrow(expl.figs))))
		,html)
	return(html)
}




#' report preprocessing
#' 
#' 
#' coming soon
#' 
#' @param report.dir coming soon
#' @param data.dir coming soon
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export 
report.preprocessing <- function(path)
{
# path = db.path	
	params = getParams(path)
	eset   = getEset(path)
	load(file.path(path,'preprocess','description.RData'))

	html    = getHtmlBits()$preprocessing

	# Insert description
	html = gsub('_PPDESCRIPTION_',description,html)
	
	# Write the paramerter values

	html = gsub('_NPROBES_'    ,nrow(eset),html)
	html = gsub('_NSAMPLES_'    ,ncol(eset),html)
	return(html)
}





#' report removals
#' 
#' 
#' coming soon
#' 
#' @param report.dir coming soon
#' @param data.dir coming soon
#' @param removal.items coming soon
#' @param third.id coming soon
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export
report.removals <- function(path)
{
	load(file.path(path,'qc','index.RData'))
	qc.figs = index$index.html
	qc.figs$File = gsub(paste('\\"',path,sep=''),'\\"files',qc.figs$File) # fix URL
	outliers = index$outliers
	html = getHtmlBits(data.dir)$removals
	
	
	# Load the qc figs summary, don't forget to fix URLs
	html = gsub('_QCFIGSTABLE_ '
		,hwrite(qc.figs,row.names=FALSE,br=TRUE,center=TRUE
		,row.bgcolor=c('#ffffaa',rep('#f1ecff',times=nrow(qc.figs)))	
	),html)	
	
	if(nrow(outliers)>0){
			html = gsub('_OUTLIERSTABLE_'
			,hwrite(outliers,row.names=FALSE,br=TRUE,center=TRUE
			,row.bgcolor=c('#ffffaa',rep('#f1ecff',times=nrow(outliers)))	
		),html)	
	}else{
		html = gsub('_OUTLIERSTABLE_','No outliers!',html)
	}
	

# 	html = hwrite(df,row.names=FALSE,br=TRUE,center=TRUE,row.bgcolor=c('#ffffaa',rep('#f1ecff',times=ncol(fit2)),'#ffbbaa'))


	
	
	# unhybridized samples
	# samples missing as a consequence of array removal (hyridizaation could be reattempted)
	# sucessful samples


	# full annotation : the usual samples annotation
	# check if works with empmty data frames !!
	return(html)
}




#' This function creates report files and returns the html of the annotation and raw data section
#' 
#' 
#' coming soon
#' 
#' @param report.dir coming soon
#' @param data.dir coming soon
#' @param annots.items coming soon
#' @param third.id coming soon
#' @note coming soon
#' @author Lefebvre F
#' @seealso coming soon
#' @references coming soon
#' @keywords coming soon
#' @export
report.annotations <-function(path,report.dir)
{

	params = getParams(path)

	html = 	getHtmlBits()$annotations

	html = gsub('_PLATFORMTYPE_',getSupportedPlatforms()[params[['platform.alias']],'pipeline.type'],html)
	html = gsub('_PLATFORM_',getSupportedPlatforms()[params[['platform.alias']],'Platform'],html)
	html = gsub('_PROBESOURCE_',getSupportedPlatforms()[params[['platform.alias']],'probe.annotation.source'],html)



	# Produce arrays.csv
	pdata = getPdata(path)
	pdata[['FilePath']] = NULL
	write.csv(pdata,file=file.path(report.dir,'files','arrays.csv'),row.names=FALSE)
	fdata = getFdata(params[["platform.alias"]])
	write.csv(fdata,file=file.path(report.dir,'files','probes.csv'),row.names=FALSE)
	if(!is.null(params[["gene.sets.db.alias"]]))
	{
		gene.sets = getGeneSets(params[["gene.sets.db.alias"]],as.list=FALSE)
		write.csv(gene.sets,file=file.path(report.dir,'files','gene_sets.csv'),row.names=FALSE)
		html=gsub('_GENESETDB_',params[["gene.sets.db.alias"]],html)
	}else{html=gsub('_GENESETDB_','none',html)}

	return(html)
}