# Loading the required libraries.
suppressPackageStartupMessages(
{
    packages = c( "componentSkeleton", "flowCore", "openCyto" )
    lapply( packages, require, character.only = TRUE )
})

# Steps from .read.FCS.csv at https://github.com/RGLab/openCyto/blob/trunk/R/functions.R
df.to.flowFrame <- function( df ) {
    mat <- as.matrix( df )
    fr <- new( "flowFrame", exprs = mat )
    pd <- pData( parameters( fr ) )
    pd$desc <- as.character( pd$desc )
    pd$name <- as.character( pd$name )
    pd$minRange[ pd$minRange < ( -111 ) ] <- -111
    pData( parameters( fr ) ) <- pd
    return( fr )
}

# Notes from read.FCS man page:
# min.limit: The minimum value in the data range that is allowed. Some
#           instruments produce extreme artifactual values. The positive
#           data range for each parameter is completely defined by the
#           measurement range of the instrument and all larger values are
#           set to this threshold. The lower data boundary is not that
#           well defined, since compensation might shift some values
#           below the original measurement range of the instrument. The
#           default value of ‘-111’ copies the behavior of flowJo. It can
#           be set to an arbitrary number or to ‘NULL’, in which case the
#           original values are kept.

flowSet.to.df <- function( fs ) {
    samples <- sampleNames( fs )
    df.list <- lapply( samples, function( x ) cbind( File = rep( x, nrow( fs[[ x ]] ) ), exprs( fs[[ x ]] ) ) )
    df <- do.call( rbind, df.list )
    return( as.data.frame( df ) )
}


execute <- function( cf ) {
    # -------------------------------------- #
    #  Read array of CSV into a flowSet object
    # -------------------------------------- #
    array.temp  <- Array.read(cf, 'in')
    array <- list()
    for(i in 1:Array.size(array.temp)) {
        key <- Array.getKey(array.temp, i)
        file <- Array.getFile(array.temp, key)
        array[[key]] <- CSV.read(file)
    }
    raw.fs <- flowSet( lapply( array, df.to.flowFrame ) )
    sampleNames( raw.fs ) <- names( array )

    # -------------------------------------- #
    #  Process parameters
    # -------------------------------------- #
    # Read parameters: negate parameter to invert channel selection
    negate <- get.parameter( cf, 'negate', 'boolean' )
    # Read parameters: channels list: TODO: numeric or character?
    channels <- get.parameter( cf, 'channels', 'string' )
    # Make list of channels to be transformed based on parameters
    cnames <- colnames( raw.fs[[1]] )
    if( ( channels == "*" && !negate ) || ( channels == "" && negate ) )   {
        # All channels
        channels <- cnames
    } else if( ( channels == "*" && negate ) || ( channels == "" && !negate ) )  {
        # None -> Do not transform anything!
        write.log( "No channels selected for transformation. Component will do nothing." )
        Array.write(cf, array, 'out')
        return( 0 )
    } else {
        # Partial list
        channels <- unlist( strsplit( channels, ',' ) )
        if (sum( !is.na(as.numeric(channels)) )) {
            if ( max( as.numeric(channels) )  > length( cnames ) ) {
                write.error( cf, 'Channel indices out of bounds' )
                return( 1 )
            }
            channels.idx.list <- as.numeric(channels)
        } else {
            channels.idx.list <- unlist( lapply( channels, grep, cnames ) )
        }
        if( !negate ) {
            channels <- cnames[ channels.idx.list ]
        } else {
            channels <- cnames[ -channels.idx.list ]
        }
    }

    # Read parameters: transformation method of choice (trying open API)
    method <- eval( parse( text = get.parameter( cf, 'transformation', 'string' ) ) )
    # Test that method is indeed of class 'transform'
    if ( !inherits( method,"transform" ) ) {
        write.error( cf, paste( 'Parameter transformation:', method, 'is not a correct R command defining an object of class transform') )
        return( 1 )
    }

    # -------------------------------------- #
    #  Transform data
    # -------------------------------------- #
    # Set transformation in the selected channels
    transform.list <- transformList( channels, method )
    # Transform the flowSet
    transformed.fs <- transform( raw.fs, transform.list )

    # -------------------------------------- #
    #  Write output array of CSV
    # -------------------------------------- #
    # Write OUTPUT ports: transformed data
    array.out <- lapply( sampleNames( transformed.fs ), function( x ) exprs( transformed.fs[[ x ]] ) )
    names( array.out ) <- sampleNames( transformed.fs )

    array.out.dir <- get.output(cf, 'out')
    if (!file.exists(array.out.dir)) {
        dir.create(array.out.dir, recursive=TRUE)
    }
    array.out.object <- Array.new()     
    for( i in 1:length(array.out) ) {
        key = names(array.out)[i]
        filename = paste(key, ".csv", sep="")
        CSV.write(paste(array.out.dir, "/", filename, sep=""), array.out[[i]])
        array.out.object <- Array.add(array.out.object, key, filename)
    }        
    Array.write(cf, array.out.object, 'out')

	return(0)
}

main(execute)

## NOTES:

    #‘linearTransform’: The definition of this function is currently x <- a*x+b
            # linearTransform(transformationId="defaultLinearTransform", a = 1, b = 0)
    #‘lnTransform’:  x<-log(x)*(r/d)
            # lnTransform(transformationId="defaultLnTransform", r=1, d=1)
    #‘logicleTransform’:
            # logicleTransform(transformationId="defaultLogicleTransform", w = 0.5, t = 262144, m = 4.5, a = 0)
    #‘biexponentialTransform’: biexp(x) = a*exp(b*(x-w))-c*exp(-d*(x-w))+f
            # biexponentialTransform(transformationId="defaultBiexponentialTransform", a = 0.5, b = 1, c = 0.5, d = 1, f = 0, w = 0, tol = .Machine$double.eps^0.25, maxit = as.integer(5000))
    #‘arcsinhTransform’: x<-asinh(a+b*x)+c)
            # arcsinhTransform(transformationId="defaultArcsinhTransform", a=1, b=1, c=0)
    #‘quadraticTransform’: x <- a*x\^2 + b*x + c
            # quadraticTransform(transformationId="defaultQuadraticTransform", a = 1, b = 1, c = 0)
    #‘logTransform’: x<-log(x,logbase)*(r/d)
            # logTransform(transformationId="defaultLogTransform", logbase=10, r=1, d=1)
    # scaleTransform: x = (x-a)/(b-a)
            # scaleTransform(transformationId="defaultScaleTransform", a, b)
    # truncateTransform: x[x<a] <- a
            # truncateTransform(transformationId="defaultTruncateTransform", a=1)