.packageName <- "flowUtils"

read.compensationML <- function(file) {
    x = xmlTreeParse(file, handlers=list(
                              "comment"=function(x,...) NULL,
                              "startElement"=function(x) {
                                  cn = paste(make.names(c(xmlNamespace(x),xmlName(x))),collapse="_")
                                  tn = make.names(xmlName(x))
                                  class(x) = c(cn,tn, class(x))
                                  x
                               }
        ),asTree=TRUE)

     x
}


#Parse a gatingML file into a filterSet
"parse.gatingML.http...www.isac.net.org.std.Gating.ML.v1.3._Gating.ML" = function(root,...) {
	ml    = new("filterSet")
	idnum = 0
	genid = function() {idnum <<- idnum + 1;paste("genid",idnum,sep="")}
	
	gate = function(g,...) UseMethod("gate")	
	createGate = function(type,g,args) {
		args$filterId = xmlGetAttr(g,"id",genid())
		f = do.call(type,args)
		ml[[NULL]] = if(!is.null(xmlGetAttr(g,"parent_id",NULL))) {
					#The parent_id tells us that we should use a subsetFilter and THAT is the filter
					#that should get the proper name
				    if(is(f,"concreteFilter")) identifier(f) = paste(identifier(f),"lhs",sep="_")
					new("subsetFilter",filters=list(f,filterReference(ml,xmlGetAttr(g,"parent_id"))),filterId=args$filterId)
				} else f
		filterReference(ml,args$filterId)
	}
	coordinate = function(g) 
		sapply(xmlGrep(g,"http...www.isac.net.org.std.Gating.ML.v1.3._coordinate"),xmlGetAttr,"value",NA,as.numeric)

	vertices   = function(g,type="http...www.isac.net.org.std.Gating.ML.v1.3._vertex") {
		do.call("rbind",lapply(xmlGrep(g,type),coordinate))
	}
	dimensions = function(g,type="parameter",default="",...) sapply(xmlGrep(g,"http...www.isac.net.org.std.Gating.ML.v1.3._dimension"),xmlGetAttr,type,default,...)
	
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._RectangleGate = function(g,...) {
		points = rbind(min=dimensions(g,"min",-Inf,as.numeric),max=dimensions(g,"max",Inf,as.numeric))
		colnames(points) = dimensions(g)
		createGate("rectangleGate",g,list(.gate=points))
	}
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._PolygonGate = function(g,...) {
		points    = vertices(g)
		colnames(points) = dimensions(g)
		if(ncol(points) != 2) stop("polygon gates must have two dimensions")
		createGate("polygonGate",g,list(boundaries=points))
	}
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._PolytopeGate = function(g,...) {
		points    = vertices(g,"http...www.isac.net.org.std.Gating.ML.v1.3._point")
		colnames(points) = dimensions(g)
		createGate("polytopeGate",g,list(boundaries=points))
	}	
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._EllipsoidGate = function(g,...) {
		foci = vertices(g,"http...www.isac.net.org.std.Gating.ML.v1.3._focus")
		colnames(foci) = dimensions(g)
		dist = as.numeric(xmlValue(xmlGrep(g,"http...www.isac.net.org.std.Gating.ML.v1.3._distance")[[1]]))
		createGate("ellipsoidGate",g,list(distance=dist,.gate=foci))
	}

	getSide = function(g,side) {
		leaf = paste("http...www.isac.net.org.std.Gating.ML.v1.3._leaf",side,sep="")
		node = paste("http...www.isac.net.org.std.Gating.ML.v1.3._node",side,sep="")
		VAL  = xmlGrep(g,leaf)
		if(length(VAL)==0) {
			VAL = xmlGrep(g,node)
			if(length(VAL)==0) stop(paste(leaf,"or",node,"is required at all levels of a decision tree."))
		}
		VAL[[1]]
	}
	makeCall = function(param,thres,LT,GTE) {
		#if both sides result in a false entry 
		NUM = if((is.logical(LT) && LT) || is.call(LT)) 1 else 0
		NUM = NUM + if((is.logical(GTE) && GTE) || is.call(GTE)) 2 else 0
		LESS  = as.call(c(as.symbol("<"),as.symbol(param),thres))
		MORE  = as.call(c(as.symbol(">="),as.symbol(param),thres))
		switch(NUM+1,
			{FALSE},
			{if(is.logical(LT)) LESS else as.call(c(as.symbol("&"),LESS,LT))},
			{if(is.logical(GTE)) MORE else as.call(c(as.symbol("&"),MORE,GTE))},
			{as.call(c(as.symbol("|"),as.call(as.symbol("&",LESS,LT)),as.call(as.symbol("&"),MORE,GTE)))}
		)
	}
	
	decisionHelper = function(g,...) {
		param = xmlGetAttr(g,"parameter")
		thres = xmlGetAttr(g,"threshold",Inf,as.numeric)
		
		LT    = getSide(g,"LT")
		GTE   = getSide(g,"GTE")
		
		if(is(LT,"http...www.isac.net.org.std.Gating.ML.v1.3._leafLT"))   LT  = if(xmlGetAttr(LT,"inside")=="true") TRUE else FALSE else LT  = decisionHelper(LT)
		if(is(GTE,"http...www.isac.net.org.std.Gating.ML.v1.3._leafGTE")) GTE = if(xmlGetAttr(GTE,"inside")=="true") TRUE else FALSE else GTE = decisionHelper(GTE)
		
		makeCall(param,thres,LT,GTE)
		
	}
	
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._DecisionTreeGate = function(g,...) {
		root = xmlChildren(g)[[1]]
		test = decisionHelper(root)
		createGate("expressionFilter",g,list(expr=test))
	}

	#For some reason BooleanGates are special in Gating-ML and their gate id information is encapsulated in an
	#outer type rather than simply defining OrGate and what have you. The suspicion is that this is a Java-ism
	#that we don't employ so we need to punt the outer gate down to the real gate.
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._BooleanGate = function(g,...) gate(xmlChildren(g)[[1]],g)
	#Boolean gate types
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._or = function(g,g2,...) {
		m = xmlChildren(g)
		m = lapply(m,function(x) gate(x))
		createGate("new",g2,list(Class="unionFilter",filterId="",filters=m))
	}
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._and = function(g,g2,...) {
		m = xmlChildren(g)
		m = lapply(m,function(x) gate(x))
		createGate("new",g2,list(Class="intersectFilter",filterId="",filters=m))
	}
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._not = function(g,g2,...)
		createGate("new",g2,list(Class="complementFilter",filterId="",filters=list(gate(xmlChildren(g)[[1]]))))
		
	#References
	gate.http...www.isac.net.org.std.Gating.ML.v1.3._gateReference = function(g,..) filterReference(ml,xmlGetAttr(g,"ref"))
	gate.default = function(g,...) {
		#A debugging tool mostly. If this happens, something has gone wrong.
		print(g)
	}
	
	#Do the actual parsing
	for(g in xmlChildren(root)) {
		gate(g)
	}
	ml
}
parse.gatingML.default = function(root,...) stop("Not a support Gating-ML XML Document")
parse.gatingML = function(root,...) UseMethod("parse.gatingML")

read.gatingML = function(file,...)
	parse.gatingML(xmlRoot(smartTreeParse(file,...)))
## Parsing Utilities

## Obtains children of a particular type
xmlGrep = function(x,type) UseMethod("xmlGrep")
xmlGrep.default = function(x,type)
	stop(paste("Looking for",type,"in",paste(class(x),collapse=",")))
xmlGrep.XMLNode = function(x,type) {
	children = xmlChildren(x)
	children[sapply(children,"is",type)]
}

smartTreeParse = function(file,...) {
	#Drops comments and tags XMLNode objects with class information related to the 
	#tag type and namespace.
	handlers = list(comment=function(x,...) NULL,startElement=function(x,...) { 
		class(x) = c(paste(make.names(c(xmlNamespace(x),xmlName(x))),collapse="_"),
					 make.names(xmlNamespace(x)),
					 class(x))
		x
		})
		xmlTreeParse(file,handlers=handlers,asTree=TRUE,fullNamespaceInfo=TRUE,...)
}


smartProcess = function(node,params,.defaults=list(),...) {
	lapply(params,function(name,...) {
		if(is.character(name))
			xmlGetAttr(node,name,.defaults[[name]])
		else if(is.function(name)) {
			def = .defaults[[name]]
			if(is.list(def)) do.call(name,c(node,def)) else name(node,def)
		} else name
	})
}

xmlToFUN   = function(FUN,...,.defaults=list())
	function(node,...) do.call(FUN,smartProcess(node,list(params),.defaults,...))
xmlToClass = function(className,...,.defaults=list()) 
	function(node,...) do.call("new",c(className,smartProcess(node,list(params),.defaults,...)))


## read.transformML("../inst/xml/linearTramsform.xml")

returnTransforms = function(g, transformationId, refs) {
   print(summary(g))
    ##If we can add it, return a reference to pick up later
	if(transformationId != "dummyTransform") {
		refs[[transformationId]] = g
		r = xmlNode("transformReference",attrs=list("ref"=transformationId), namespace="transforms")
                class(r) = c("transforms_transformsReference",class(r))
		r
	} else
		g
       print(g)
}

##Linear transformation
transforms.transforms_linear= function(x,refs,...) {
  print("linear")
  cn = xmlGetAttr(x, "parameter","")
  a =  xmlGetAttr(x, "a", 1, as.double)
  b =  xmlGetAttr(x, "b", 0, as.double)
 
  returnTransforms(linearTransform(transformationId="", "a"=a, "b"=b), transformationId="dummyTransform", refs)
}

##quadratic transformation
transforms.transforms_quadratic= function(x,refs,...) {
  print("quadratic")
  
  cn = xmlGetAttr(x, "parameter","")
  a =  xmlGetAttr(x, "a", 1, as.double)
  b =  xmlGetAttr(x, "b", 1, as.double)
  c =  xmlGetAttr(x, "c", 0, as.double)

  returnTransforms(quadraticTransform(transformationId="", "a"=a, "b"=b, "c"=c), transformationId="dummyTransform", refs)
}


##Ln transformation
transforms.transforms_ln= function(x,refs,...) {
  print("ln")
  cn = xmlGetAttr(x, "parameter","")
  r =  xmlGetAttr(x, "r", 1, as.double)
  d =  xmlGetAttr(x, "d", 1, as.double)
 
  returnTransforms(lnTransform(transformationId="", "r"=r,"d"=d), transformationId="dummyTransform", refs)
}

##log transformation
transforms.transforms_log= function(x,refs,...) {
  print("log")
  cn = xmlGetAttr(x, "parameter","")
  logbase =  xmlGetAttr(x, "logbase", 10, as.double)
  r =  xmlGetAttr(x, "r", 1, as.double)
  d =  xmlGetAttr(x, "d", 1, as.double)
  
  returnTransforms(logTransform(transformationId="", "logbase"=logbase, "r"=r,"d"=d), transformationId="dummyTransform", refs)
}

##logicle transformation
transforms.transforms_logicle= function(x,refs,...) {
 print("logicle")
  ##cn = xmlGetAttr(x, "parameter","")
  ##b =  xmlGetAttr(x, "b", 1, as.double)
  ##w =  xmlGetAttr(x, "w", 0, as.double)
  ##r =  xmlGetAttr(x, "r", 262144, as.double)
  ##tol =  xmlGetAttr(x, "tol", .Machine$double.eps^0.25, as.double)
  ##maxit= xmlGetAttr(x, "maxit", 5000, as.integer)
  res = "not implemented"
  res
 
 ## returnTransforms(logicleTransform(transformationId="dummyTransform", "b"= b, "w"= w, "r"=r, "tol"= tol, maxit="maxit"), transformationId="dummyTransform",refs)
}


##Bi-exponential transformation
transforms.transforms_bi.exponential= function(x,refs,...) {
 print("bi")
  cn = xmlGetAttr(x, "parameter","")
  a =  xmlGetAttr(x, "a", .5, as.double)
  b =  xmlGetAttr(x, "b", 1,  as.double)
  c =  xmlGetAttr(x, "c", .5, as.double)
  d =  xmlGetAttr(x, "d", 1,  as.double)
  f =  xmlGetAttr(x, "f", 0,  as.double)
  w =  xmlGetAttr(x, "w", 0,  as.double)
  tol =  xmlGetAttr(x, "tol", .Machine$double.eps^0.25, as.double)
  maxit= xmlGetAttr(x, "maxit", 5000, as.integer)
  
 returnTransforms(biexponentialTransform(transformationId="", "a"= a, "b"= b,"c"= c,"d"= d,"f"= f,"w"= w, "tol"= tol, maxit="maxit"),
                   transformationId="dummyTransform", refs)
}

transforms.transforms_hyperlog= function(x,refs,...) {
 print("hyper")
  res = "not implemented"
  res
}


transforms.transforms_split.scale= function(x,refs,...) {
 print("split")
  res = "not implemented"
  res
}

transforms.XMLNode = function(x,...) paste(xmlName(x), xmlGetAttr(x, "id"), sep=":")
transforms.default = function(x,...) x
transforms = function(x,...) UseMethod("transforms")

transforms.transformsReference = function(x,refs,...) {
	y = refs[[xmlGetAttr(x,"ref")]]
	if(is.null(y))
		stop(paste("Unable to resolve reference \"",xmlGetAttr(x,"ref"),"\"",sep=""))
	y
}

read.transformML = function(file) {
	#Read in the XML file and mark it up 
	#so that we can use dispatch	
	x = xmlTreeParse(file,
		handlers=list(
                  "comment"=function(x,...) NULL,
                  "startElement"=function(x) {
                    cn = paste(make.names(c(xmlNamespace(x),xmlName(x))),collapse="_")
                    tn = make.names(xmlName(x))
                    class(x) = c(cn,tn, class(x))
                    x
                  }
                  
	),asTree=TRUE)
        
        ##A place to stash our transformation ids
	transform_list = new.env(hash=TRUE)
	end = FALSE
        last_len = length(ls(env=transform_list))
       	if(!is(xmlRoot(x),"transforms_Transformation.ML"))
		stop("Not a transformML Document")
	ret = xmlChildren(xmlRoot(x))
        nomen = sapply(ret,xmlGetAttr,"newName")
        
        def = sapply(ret, xmlChildren)
        noDef = which(names(def)!= "transformation.pre-defined")
        if(length(noDef) > 0)
          stop("Do not know what to do yet")
        ans <-sapply(def, xmlChildren)
        names(ans) <- nomen 
        print(ans)
        attempts = 0
        
        while(!end) {
            ret = lapply(ans, transforms, transform_list)
            new_len = length(ls(env= transform_list))
            if(new_len != last_len) attempts = 0
            if(all(sapply(ret,is,"transforms")) || attempts >= 5) end = TRUE
            last_len = new_len
            attempts = attempts + 1
	}

        for(i in 1:length(ret)){
          ret[[i]]@transformationId = nomen[i]}

        names(ret) = nomen 
	ret
    }










