R/visualization_functions.R

Defines functions filter_id visualize_network

Documented in filter_id visualize_network

####################################################################################
##################################### filter visnetwork data ############################
####################################################################################

#' visualize_network
#'
#' function to visualize the network based on the connections and different conditions
#' @param data List of two ffdf objects (format generated by the geNet() function ). Mandatory argument
#' @param select_group select the groups to filter data. Optional argument.
#' @param select_tooltip select the annotation keywords to filter data. Optional argument. 
#' Note: the tooltip values are the values that appear when hovering the nodes 
#' @param select_size select the size of the nodes to filter data. Optional argument. 
#' @param clust_method select the clustering method. Default to Infomap.
#' @param select_ID  select the IDs to filter data. Optional argument.
#' @return data: data object filtered
#' @export
#' @examples
#' \dontrun{
#' data_subsetted<-visualize_network(data,select_group=c("group_1","group_5"))
#' data_subsetted<-visualize_network(data,select_tooltip=c("protein","secretion"))
#' data_subsetted<-visualize_network(data,clust_method="louvain")
#' }
#' @import ff ffbase igraph visNetwork
visualize_network<-function(data,select_group=NULL,select_tooltip="None",
                            select_size="None",
                            clust_method="None",
                            select_ID=NULL){
  #--------- check input data for visualization ----------------------
  check_input_visualization(data)
  #----------------------- select group -------------------
  if(is.character(select_group)==T){
    out<-as.character(data$nodes$group[]) %in% select_group
    out<-ff(out)
    inds <- ffwhich(out,out==T)
    if(length(inds)!=0){
      data$nodes<-data$nodes[inds,]
    }else{
      return(NULL)
    }
    # remove the nodes in data$edges not present in data$nodes
    output<-as.character(data$edges$from[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
    output<- as.character(data$edges$to[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
  }
  gc()
  #----------------------- select tooltip -------------------
  if(select_tooltip!="None"){
    inds<-grep(select_tooltip,as.character(data$nodes$title[]))
    tooltip_selected<-as.character(data$nodes$title[])[inds]
    out<-as.character(data$nodes$title[]) %in% tooltip_selected
    out<-ff(out)
    inds <- ffwhich(out,out==T)
    if(length(inds)!=0){
      data$nodes<-data$nodes[inds,]
    }else{
      return(NULL)
    }
    # remove the nodes in data$edges not present in data$nodes
    output<-as.character(data$edges$from[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
    output<- as.character(data$edges$to[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
  }
  gc()
  #----------------------- select size -------------------
  if(select_size!="None"){
    if(is.numeric(select_size)==F){
      stop("size input must be numeric")
    }
    x<-data$nodes$size
    inds<-ffwhich(x,x<select_size)
    if(length(inds)!=0){
      data$nodes<-data$nodes[inds,]
    }
    # remove the nodes in data$edges not present in data$nodes
    output<-as.character(data$edges$from[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
    output<- as.character(data$edges$to[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
  }
  gc()
  #-----------------------  re-execute the clustering algorithm -------------------
  if(clust_method!="None"){
    print(" ------ re-execution of the clustering ------")
    igraph_network<-gen_network_obj(as.data.frame(data$edges))
    gc()
    data_new_groups<-get_groups_based_on_clustering(igraph_network,method=clust_method)
    igraph_network<-igraph_network %>% set_vertex_attr(name="color",
                                                       index = vertex_attr(igraph_network)$name,
                                                       value = data_new_groups$final_col_vec)
    gc()
    data <- gen_visnetwork_data(igraph_network)
  }
  gc()
  #----------------------- select ID -------------------
  if(is.null(select_ID)==F){
    data<-filter_id(data=data,selected_id = select_ID)
  }
  gc()
  return(data)
}

#' function to filter the genes ID
#'
#' function to filter the genes ID from data. It is called automatically by the visualize_network() function
#' @param data List of two ffdf objects (format generated by the geNet() function ). Mandatory argument
#' @param selected_id select the ids to filter data. Optional argument.
#' @return data: data object filtered
#' @import ff ffbase

filter_id<-function(data,selected_id){
  out<-as.character(data$nodes$id[]) %in% selected_id
  out<-ff(out)
  inds<-ffwhich(out,out==T)
  if(length(inds)!=0){
    data$nodes<-data$nodes[inds,]
    # remove the nodes in data$edges not present in data$nodes
    output<-as.character(data$edges$from[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
    output<- as.character(data$edges$to[]) %in% as.character(data$nodes$id[])
    output<-ff(output)
    inds <- ffwhich(output,output==T)
    if(length(inds)!=0){
      data$edges<-data$edges[inds,]
    }
    return(data)
  }else{
    warning("selected ID not found. Unmodified data returned")
    return(data)
  }
}
haneylab/geNet documentation built on Oct. 4, 2020, 8:40 a.m.