R/layout.R
e69ebc9f
 .getCoordinates = function(x, r) {
 	l = length(x)
 	d = 360/l
 	c1 = seq(0, 360, d)
 	c1 = c1[1:(length(c1)-1)]
 	tmp = t(sapply(c1, function(cc) c(cos(cc*pi/180)*r, sin(cc*pi/180)*r)))
 	rownames(tmp) = x
 	tmp
 }
 
 .checkValid = function(x) {
 	if(any(table(x) > 1)) FALSE else TRUE
 }
 
 # TODO: make layout independent the $name $label (i.e. based on indexes.)
 layout.concentric = function (g, concentric = NULL, radius = NULL, order.by) 
 {
 	if(is.null(concentric))
     concentric = list(V(g)$name)
 
 	all_c = unlist(concentric, use.names = FALSE)
 	
   if (!.checkValid(all_c))
 	  stop("Duplicated nodes in layers!")
 	
 	if (!.checkValid(radius)) 
 	  stop("Duplicated radius in layers!")
 	
 	all_n = V(g)$name
 	sel_other = all_n[ ! all_n %in% all_c ]
 	
 	if(length(sel_other) > 0)
 	  concentric[[length(concentric)+1]] = sel_other
     
 	if(is.null(radius)) {
 		radius = seq(0, 1, 1/(length(concentric)))
 		if(length(concentric[[1]]) == 1)
 			radius = radius[-length(radius)]
 		else
 			radius = radius[-1]
 	}
 	
 	if( ! missing(order.by) )
 		order.values = lapply(order.by, function(b) get.vertex.attribute(g, b))
 		
 	res = matrix(NA, nrow = length(all_n), ncol = 2)
 	for(k in 1:length(concentric)) {
 		r = radius[k]
 		l = concentric[[k]]
     
 		i = which(V(g)$name %in% l) - 1
 		i_o = i
 		if (!missing(order.by)) {
 			ob = lapply(order.values, function(v) v[i + 1])
 			ord = do.call(order, ob)
 			i_o = i_o[ord]
 		}
 		res[i_o+1, ] = .getCoordinates(i_o, r)
 
 	}
 	res
 }
 
 getConcentricList = function(g, t, e, max.size = 60, order.by = "label") {
 	sel.all = V(g)$name
 	
 	# filter out not in graph.
 	t = t[t %in% sel.all]
 	e = e[e %in% sel.all]
 	
 	sel.e = V(g)[ e ]$name
 	sel.t = V(g)[ t ]$name
 	sel.t = sel.t[sel.t %in% sel.e ] # choose only target that are enriched.
 	sel.e = sel.e[! sel.e %in% sel.t ]
 	
 	sel.b = sel.all[! sel.all %in% c(sel.t, sel.e) ]
 	
 	tmp = list(sel.t, sel.b, sel.e)
 
   if(!is.null(order.by)) {
     tmp = lapply(tmp, function(l) {
       l[order(get.vertex.attribute(g, order.by, V(g)[ l ]))]
     })
   }
 
 	res = list()
 	for(k in 1:length(tmp)) {
 		r = tmp[[k]]
     if(length(r)>max.size) {
       s = ceiling(length(r)/max.size)
       #r1 = split(r,rep(1:s, s,length.out = length(r)))
       v = rep(1:s, each = ceiling(length(r)/s))
       v = v[1:length(r)]
       r1 = split(r,v)
       for(kk in r1) {
         res[[length(res)+1]] = kk
       } 
     }	else res[[length(res)+1]] = r
 	}
 	res
 }
648decca
 
 layout.arc = function (g, target, query)
 {
   n = vcount(g)
   if(! all(target %in% V(g)$name)) {
     warning("some targets not in graph, removing them.")
     target=target[target %in% V(g)$name]
   }
   
   #
   target = target[target %in% query]
   
   V(g)$type = "bridge"
35f6457e
   all_name=V(g)$name # could be V(g)[ name %in% query ] but want to avoid "note's" in R CMD check.
   V(g)[all_name %in% query]$type = "query"
   V(g)[all_name %in% target]$type = "target"
648decca
   
   g_con = g
   n_left = character()
   
   if(! is.connected(g)) {
     g_con = getLargestComp(g)
     n_left = setdiff(V(g)$name,V(g_con)$name)
   }
   
35f6457e
   all_type=V(g_con)$type
   all_name=V(g_con)$name
   set = list(target = target, bridge=V(g_con)[all_type == "bridge"]$name, query1 = character(), query2 = character(), query3 = character(), left=n_left)
   for(q in V(g_con)[all_type == "query"]$name) {
     sp = get.all.shortest.paths(g_con,from=V(g_con)[q],to=V(g_con)[all_name %in% target])
3c3a88bd
     #print(sp)
648decca
     sp_min = min(sapply(sp$res,length))
3c3a88bd
     #print(sp_min)
648decca
     if(sp_min == 2) {
       set$query1 = c(set$query1, V(g_con)[q]$name)
     }
     else set$query2 = c(set$query2, V(g_con)[q]$name)
   }
   
   set = lapply(set,function(s) {
     ns = V(g)[s]$label
     s[order(ns,decreasing=TRUE)]
   })
   
   x0 = c(left=-2,query1=-1,target=0,bridge=1,query2=2)
   y0 = sapply(set,function(x){
     -1 * floor(length(x)/2)
   })
   
   res = matrix(NA, nrow = n, ncol = 2)
   all_n = unlist(set)
   for(my_n in all_n) {
     k = which(V(g)$name == my_n)
     my_type = names(set)[sapply(set,function(x) my_n %in% x)]
     x1 = x0[my_type]
     y1 = y0[my_type]
     y0[my_type] = y0[my_type] + 1
     res[k,1] = x1
     res[k,2] = y1
   }
   res
 }