library(componentSkeleton)
library(bitops)

LIMIT.SPECIAL <- -0.000001

execute <- function(cf) {
    width.cm     <- get.parameter(cf, 'width',     'float')
    height.cm    <- get.parameter(cf, 'height',    'float')
    common.scale <- get.parameter(cf, 'commonScale')
    y.low        <- get.parameter(cf, 'yLow',      'float')
    y.high       <- get.parameter(cf, 'yHigh',     'float')
    x.low        <- get.parameter(cf, 'xLow',      'float')
    x.high       <- get.parameter(cf, 'xHigh',     'float')
    vpInf        <- get.parameter(cf, 'pInf',      'float')
    vnInf        <- get.parameter(cf, 'nInf',      'float')
    plotType     <- get.parameter(cf, 'plotType')
    pngImage     <- get.parameter(cf, 'pngImage')
    leg.pos      <- get.parameter(cf, 'legendPosition')
    do.sort      <- get.parameter(cf, 'sort', 'boolean')
    draw.x       <- get.parameter(cf, 'drawX', 'boolean')
    dpcm         <- get.parameter(cf, 'dpCm',    'float')
    myName       <- get.metadata(cf, 'instanceName')
    if (input.defined(cf,'originalData')) {
        # if origData is given, add the basename of the file in the instance name.
        # it will be used in the naming of the plot file. (remove .csv and all .:s)
        myName <- paste(myName,gsub('\\.','_',sub('\\.csv$','',basename(get.input(cf, 'originalData')))),sep='_')
    }
	
	width.pixels <- dpcm * width.cm
	
    if (width.cm == 0) {
        write.error(cf, 'Parameter "width" is 0')
        return(INVALID_INPUT)
    }
    if (height.cm == 0) {
        write.error(cf, 'Parameter "height" is 0')
        return(INVALID_INPUT)
    }

    #width.inches  <- width.cm * 0.3937008
    #height.inches <- height.cm * 0.3937008
	
    #aspect        <- width.cm / height.cm
    #height.pixels <- as.integer(round(width.pixels / aspect))
	
    out.dir <- get.output(cf, 'out')
    dir.create(out.dir, recursive=TRUE)

    tex <- character()
    section.title <- get.parameter(cf, 'sectionTitle')
    if (nchar(section.title) > 0) {
        tex <- c(tex, sprintf('\\%s{%s}\\label{%s}',
                              get.parameter(cf, 'sectionType'),
                              section.title,
                              myName))
    }

    y <- CSV.read(get.input(cf, 'y'))
    if (input.defined(cf, 'ySummary')) {
        ySummary <- CSV.read(get.input(cf, 'ySummary'))
    } 

    y.columns <- split.trim(get.parameter(cf, 'yColumns'), ',')
    if (identical(y.columns, '*')) y.columns <- colnames(y)
    if (nrow(y) < 1) {
       tex <- c(tex, "No p-values available!")
       latex.write.main(cf, 'out', tex)
       return(0)
    }

    if (input.defined(cf, 'x')) {
        x <- CSV.read(get.input(cf, 'x'))
        xSummary <- CSV.read(get.input(cf, 'xSummary'))

        x.columns <- split.trim(get.parameter(cf, 'xColumns'), ',')
        if (identical(x.columns, '*')) x.columns <- colnames(x)
        if (length(x.columns) != length(y.columns)) {
            write.error(cf, 'xColumns and yColumns must have the same number of items')
            return(PARAMETER_ERROR)
        }
        if (nrow(x) != nrow(y)) {
            write.error(cf, 'x and y must have the same number of rows')
            return(INVALID_INPUT)
        }
    } else {
        x         <- NULL
        x.columns <- NULL
    }

	
    skip <- integer()
    for (i in 1:length(y.columns)) {
        if (!is.numeric(y[,y.columns[i]])) {
            write.log(cf, sprintf('Skipping column %s in y: not numeric', y.columns[i]))
            skip <- c(skip, i)
            next
        }
        if (!is.null(x)) {
            if (!is.numeric(x[,x.columns[i]])) {
                write.log(cf, sprintf('Skipping column %s in x: not numeric', x.columns[i]))
                skip <- c(skip, i)
                next
            }
        }
    }
    if (length(skip) > 0) y.columns <- y.columns[-skip]
    y <- y[,y.columns,drop=FALSE]
    y.transform <- trim(get.parameter(cf, 'yTransformation'))
    if (nchar(y.transform) > 0) {
        y <- eval(parse(text=y.transform))
    }
    y[y== Inf] <- vpInf
    y[y==-Inf] <- vnInf
    min.y <- min(y, na.rm=TRUE)
    max.y <- max(y, na.rm=TRUE)

    if (!is.null(x)) {
        if (length(skip) > 0) x.columns <- x.columns[-skip]
        x <- x[,x.columns,drop=FALSE]
        if (!is.null(x)) {
            x.transform <- trim(get.parameter(cf, 'xTransformation'))
            if (nchar(x.transform) > 0) {
                x <- eval(parse(text=x.transform))
            }
        }
        x[x== Inf] <- vpInf
        x[x==-Inf] <- vnInf
        min.x <- min(x, na.rm=TRUE)
        max.x <- max(x, na.rm=TRUE)
    } else {
        min.x <- NULL
        max.x <- NULL
    }

    if (input.defined(cf, 'labels')) {
        labels <- CSV.read(get.input(cf, 'labels'))
            
        if(get.parameter(cf, 'labelColumn') == ''){
            labels <- labels[,1]
        }else{
            labels <- labels[, get.parameter(cf, 'labelColumn')]
        }
            
        if (length(labels) != length(y.columns)) {
            write.error(cf, 'yColumns and labels must have the same number of items')
            return(PARAMETER_ERROR)
        }
            
    }else{
        labels <- y.columns
        label.counts <- apply(y,2,function(x) sum(!is.na(x)))
    }
    
    #there might be same labels and they should be printed in same colors
    color.labels <- unique(labels)
    line.colors <- c('black', rainbow(length(color.labels)-1))
    line.symbols <- rep(0,length(line.colors))
    for (l in 1:length(line.symbols)) {
        line.symbols[l]<-(l%%5)+21
    }
    if(get.parameter(cf, 'colorFunction') != ""){
        colorFunction <- sprintf(get.parameter(cf, 'colorFunction'), length(color.labels))
        line.colors <- eval(parse(text=colorFunction))
    }
            
    if (draw.x) xaxt <- 's'
    else xaxt <- 'n'
    
    ylab    <- get.parameter(cf, 'yLabel')
    main    <- get.parameter(cf, 'title')
    caption <- get.parameter(cf, 'caption')
    xlab    <- get.parameter(cf, 'xLabel')
            
    
    name <- plot.image(width.cm, height.cm, width.pixels, pngImage, myName, 0, out.dir)
            
    tex <- c(tex, latex.figure(name, caption=caption, image.width=width.cm))
    
    plotnum <- 1
    # First draw all data points
    for (i in 1:length(y.columns)) {
        j <- i	
        y.column <- y[,y.columns[i]]

        if (do.sort) y.column <- sort(y.column)
        if (!is.null(x)) {
            x.column <- x[,x.columns[i]]
        } else {
            x.column <- c(1:length(y.column))
        }

        #graphical parameters and plotting
        par(pch=20, cex=0.7)
        color <- line.colors[color.labels == labels[j]]
        
        if(j == 1){
            
            if (common.scale) {
                ylim <- compute.limits(y.column, y.low, y.high, min.y, max.y)
                xlim <- compute.limits(x.column, x.low, x.high, min.x, max.x)
            } else {
                ylim <- compute.limits(y.column, y.low, y.high, NA, NA)
                xlim <- compute.limits(x.column, x.low, x.high, NA, NA)
            }
            plot(x=x.column, y=y.column, 
                            t=plotType, main=main, xaxt=xaxt,
                            xlab=xlab, ylab=ylab, 
                            xlim=xlim, ylim=ylim, col=color, pch=".")
        }
                
        if(plotType == 'l'){
                lines(x=x.column, y=y.column, col=color)
        } else {
                points(x=x.column, y=y.column, t=plotType, col=color, pch=".")
        }
    }
    # Then draw the summary points
    for (i in 1:length(y.columns)) {
        j <- i	
        y.column <- y[,y.columns[i]]

        if (do.sort) y.column <- sort(y.column)
        if (!is.null(x)) {
            x.column <- x[,x.columns[i]]
        } else {
            x.column <- c(1:length(y.column))
        }
        color <- line.colors[color.labels == labels[j]]

        if(!plotType == 'l'){
            ix <- match(xSummary, x.column)
            iy <- match(ySummary, y.column)
            hit <- -1
            for (i2 in 1:length(ix)) {
                if (!is.na(ix[i2]) && !is.na(iy[i2] && ix[i2] == iy[i2])) hit <- i2
            }
        
            if (hit > -1) {
                #write.log(cf, sprintf('Match: xcol %s ycol %s', xSummary[hit], ySummary[hit]))
                par(cex=2)
                if (color == 'black') { 
                    points(x=c(xSummary[hit]), y=c(ySummary[hit]), t=plotType, pch=line.symbols[hit], cex=1, bg='white', col='black')
                    points(x=c(xSummary[hit]), y=c(ySummary[hit]), t=plotType, pch=line.symbols[hit], cex=0.5, bg=color, col='black')
                }
                else {
                    points(x=c(xSummary[hit]), y=c(ySummary[hit]), t=plotType, pch=line.symbols[hit], cex=1, bg=color, col='black')
                }

                # Restore standard plotting parameters.
                par(pch=20, cex=0.7)
            }
        }
            
        #add annotations to the plot
        if (input.defined(cf, 'plotAnnotator')) {
            if (is.null(x.columns)) x.name <- NULL
            else x.name <- x.columns[i]
            run.script(get.input(cf, 'plotAnnotator'), y.column, x.column, y.columns[i], x.name, cf)
        }


        plotnum <- plotnum + 1
    }



    if (!input.defined(cf, 'labels')) {
        color.legend<-color.labels
        for (l in 1:length(color.labels)) {
        color.legend[l]=paste(color.labels[l]," (",label.counts[l],")",sep="")
        }
    } else {
        color.legend<-color.labels
    }
    if (leg.pos != 'off') {
            legend(x=leg.pos, legend=color.legend,
                    #fill=line.colors[1:length(color.labels)],
                    pt.bg=line.colors[1:length(color.labels)],
                    text.col='black',pch=line.symbols)
    }
    
    if(pngImage){
            png.close()
    }else{
            dev.off()
    }


    latex.write.main(cf, 'out', tex)
    return(0)
}

compute.limits <- function(values, parameter.low, parameter.high, common.low, common.high) {
    if (is.null(values)) return(NULL)

    limits <- c(NA, NA)

    if (!identical(parameter.low, LIMIT.SPECIAL)) limits[1] <- parameter.low
    else if (is.numeric(common.low)) limits[1] <- common.low
    else limits[1] <- min(values, na.rm=TRUE)

    if (!identical(parameter.high, LIMIT.SPECIAL)) limits[2] <- parameter.high
    else if (is.numeric(common.high)) limits[2] <- common.high
    else limits[2] <- max(values, na.rm=TRUE)

    return(limits)
}

run.script <- function(r.file, y.column, x.column, y.name, x.name, cf) {
    eval(parse(file=r.file))
}

plot.image <- function(width.cm, height.cm, width.pixels, png, instanceName, plotnum, out.dir){

	base.name <- sprintf('%s-%d', instanceName, plotnum)
	filename  <- file.path(out.dir, base.name)
	
	if(png){

		aspect        <- width.cm / height.cm
		height.pixels <- as.integer(round(width.pixels / aspect))
		
		png.open(paste(filename, '.png', sep=''), width=width.pixels, height=height.pixels)
		
	}else{

		width.inches  <- width.cm * 0.3937008
		height.inches <- height.cm * 0.3937008
		
		pdf(paste(filename, '.pdf', sep=''), paper='special', width=width.inches, height=height.inches)	
	}
	
	return(base.name)
}

main(execute)