## R_functions.R

### functions

netFromClusters<-function(cls, th)
{
	clusters = unlist(cls)
	f=factor(clusters)
	clusters=split(clusters, f)
	cnt=lapply(clusters,length)
	cnt=unlist(cnt)
	
	
	get_clusters=names(cnt)[cnt>=max(cnt)*th]
	get_clusters=c(get_clusters, paste(sort(unique(unlist(strsplit(names(cnt), "\\|")))), collapse="|"))
	get_clusters=unique(get_clusters)
	
	get_clusters_L=strsplit(get_clusters, "\\|")

	clusters_tab=cbind(names(cnt)[order(-cnt)], cnt[order(-cnt)])
	clusters_tab=clusters_tab[as.numeric(clusters_tab[,2])>=max(cnt)*.02, ]
	


	
	for(i in 1:dim(clusters_tab)[1])
	{
		test_cluster=clusters_tab[i,1]
		if(!any(get_clusters==test_cluster))
		{
			x=strsplit(test_cluster, "\\|")[[1]]
			if(all(unlist(lapply(get_clusters_L, check_cl, x))))
			{
				get_clusters=c(get_clusters, test_cluster)
				get_clusters_L=strsplit(get_clusters, "\\|")
			}
		}
	}

	get_clusters=unique(get_clusters)
	
	sizes=strsplit(get_clusters, "\\|")
	sizes=unlist(lapply(sizes, length))
	clusters=get_clusters[rev(order(sizes))]
	
	
	edges=matrix(c(1, 2), nrow=1)
	in1=c("root",clusters[1])
	nnodes=2
	parents=c("", clusters[1])
	
	for(i in 2:length(clusters))
	{
		nnodes=nnodes+1
		parents=c(parents, "")
		pcl=c()
		c1=strsplit(clusters[i], "\\|")[[1]]
		for(n in length(in1):2)
		{
			if(!any(pcl==in1[n]))
			{
				in1V=strsplit(in1[n], "\\|")[[1]]
				if(length(in1V[in1V %in% c1])==length(c1)) 
				{
					edges=rbind(edges, c(n, nnodes))
					if(length(in1)<nnodes)
					{
						parents[nnodes]=paste(in1[n], "_",parents[n], sep="")
					}
					else
					{
						parents[nnodes]=paste(parents[nnodes], "_",in1[n], "_",parents[n], sep="")
					}
					if(length(in1)<nnodes)
					{
						in1=c(in1,clusters[i])
					}
					
					pcl=strsplit(parents[nnodes], "_")[[1]]
				}
			}
		}
		if(is.hybridization(net=list(edge=edges), nnodes))
		{
			edges=rbind(edges,c(nnodes, nnodes+1))
			parents=c(parents, "")
			parents[nnodes+1]=parents[nnodes]
			nnodes=nnodes+1
			
			in1=c(in1,clusters[i])
			
		}	
	}
	
	
	net = list(edge=edges, node.label=in1)
	net_text = printNet(net, in1)
	
	return(list(network = net, network_string = net_text))


}














check_cl<-function(x, y)
{
	
	if(length(x[x %in% y])==length(y) | length(y[y %in% x])==length(x) | length(y[y %in% x])==0)
	{
		return(TRUE)
	}
	else
	{
		return(FALSE)
	}
}






getClusters<-function(tre1, bTh)
{
	tre=tre1
	if(is.null(tre$node.label))
	{
		tre$node.label = rep("100", tre$Nnode)
	}
	tre$node.label[is.na(tre$node.label)]=1
	tre$node.label[tre$node.label==""]=0
	cls=c()
	if(length(tre$node.label)==tre$Nnode)
	{
		for(n in 1:tre$Nnode)
		{
			if(as.numeric(tre$node.label[n])>=bTh)
			{
				tt=extract.clade(tre, n+length(tre$tip.label))
				cl=paste(sort(unique(tt$tip.label)), collapse="|")
				cls=c(cls, cl)	
			}
		}
	}
	cls=c(cls,tre$tip.label)	
	cls=unique(cls)
	return(cls)
}

printNet<-function(net, node.label)
{
	my_res=makeMap(net)
	tree=my_res[[1]]
	map=my_res[[2]]
	tips=net$edge[!net$edge[,2] %in% net$edge[,1], 2]
	root=unique(tree$edge[! tree$edge[,1] %in% tree$edge[,2],1])
	res=printMyTree(tree=tree, node=root, map=map, tips=tips, node.label=node.label)
	#cat(";", sep="")
	return(paste(res, ";", sep=""))
}


printMyTree<-function(tree, node, map, tips, node.label)
{
	ch=tree$edge[tree$edge[,1]==node,2]
	if(length(ch)>=2)
	{
		#cat("(")
		el1="("
		elm=c()
		for(ci in 1:length(ch))
		{
			el2=printMyTree(tree, ch[ci], map, tips, node.label)
			elm=c(elm, el2) 
			if(ci!=length(ch))
			{
				#cat(",")
				elm=c(elm, ",")
			}
		}
		if(any(map[,2]==as.character(node)))
		{
			#cat(")", map[map[,2]==as.character(node), 1], sep="")
			el5=paste(")", map[map[,2]==as.character(node), 1], sep="")
		}
		else
		{
			#cat(")", sep="")
			el5=")"
		}
		return(paste(el1, paste(elm, collapse=""), el5, sep=""))
	}
	else
	{
		if(length(ch)==1)
		{
			#cat("(")
			el1="("
			el2=printMyTree(tree, ch, map, tips, node.label)
			if(any(map[,2]==as.character(node)))
			{
				#cat(")", map[map[,2]==as.character(node), 1], sep="")
				el3=paste(")", map[map[,2]==as.character(node), 1], sep="")
			}
			else
			{
				#cat(")", sep="")
				el3=")"
			}
			
			return(paste(el1, el2, el3, sep=""))

		}	
		else
		{
			
			if(any(map[,2]==as.character(node)))
			{
				#cat(map[map[,2]==as.character(node), 1], sep="")
				el1=paste(map[map[,2]==as.character(node), 1], sep="")
			}
			else
			{
				#cat("s",which(tips==node), sep="")
				#el1=paste("s",which(tips==node), sep="")
				#cat(node.label[tips[tips==node]], sep="")
				el1=node.label[tips[tips==node]]
			}
			return(el1)
		}
	}
}

makeMap<-function(net)
{
	
	nodes=unique(c(net$edge[,1], net$edge[,2]))
	h=0
	map_nodes=c()
	map_names=c()
	for(n in nodes)
	{
		if(is.hybridization(net, n))
		{
			h=h+1
			map_names=c(map_names,paste("#H", h, sep=""))
			map_nodes=c(map_nodes, n)
			nb=which(net$edge[,2]==n)
			m=max(unique(c(net$edge[,1], net$edge[,2])))	
			for(i in 1:(length(nb)-1))
			{
				net$edge[nb[i],2]=m+i
				map_names=c(map_names,paste("#H", h, sep=""))
				map_nodes=c(map_nodes, m+i)
			}
		}
	}
	tre=net
	map=cbind(map_names, map_nodes)
	return(list(net, map))
}





is.hybridization<-function(net, node)
{
	p=net$edge[net$edge[,2]==node, 1]
	if(length(p)>1)
	{
		return(TRUE)
	}
	else
	{
		return(FALSE)
	}
}

