R/layout.R

In rTRM: Identification of transcriptional regulatory modules from PPI networks

.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
}

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"
  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"
  
  g_con = g
  n_left = character()
  
  if(! is.connected(g)) {
    g_con = getLargestComp(g)
    n_left = setdiff(V(g)$name,V(g_con)$name)
  }
  
  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])
    #print(sp)
    sp_min = min(sapply(sp$res,length))
    #print(sp_min)
    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
}