R/plot.R

In abodein/netOmics: Multi-Omics (time-course) network-based integration and interpretation

#' Summary Plot RWR attributes
#' 
#' Based on the results of 
#' \code{\link[netOmics]{rwr_find_seeds_between_attributes}} which identify the
#'  closest k neighbors from a seed, this function returns a barplot of the node
#'   types (layers) reached for each seed.
#' 
#' @param X a 'rwr.attributes' or 'list.rwr.attributes' object 
#' from rwr_find_seeds_between_attributes()
#' @param color (optional) a named character vector or list, 
#' list of color to apply to each type
#' @param seed.id (optional) a character vector, to filter the results and 
#' filter on specific seeds IDs
#' @param seed.type (optional) a character vector, to filter the results and 
#' filter on specific seeds types
#' @param plot logical, if TRUE then the plot is produced
#' 
#' @return 
#' a 'ggplot' object
#' 
#' @seealso \code{\link[netOmics]{random_walk_restart}}, 
#' \code{\link[netOmics]{rwr_find_seeds_between_attributes}}
#' 
#' @examples 
#' graph1 <- igraph::graph_from_data_frame(
#'     list(from = c("A", "B", "A", "D", "C", "A", "C"), 
#'          to = c("B", "C", "D", "E", "D", "F", "G")), 
#'     directed = FALSE)
#' graph1 <- igraph::set_vertex_attr(graph = graph1, 
#'                                   name = 'type', 
#'                                   index = c("A","B","C"),
#'                                   value = "1")
#' graph1 <- igraph::set_vertex_attr(graph = graph1,
#'                                   name = 'type', 
#'                                   index = c("D","E"),
#'                                   value = "2")
#' graph1 <- igraph::set_vertex_attr(graph = graph1,
#'                                   name = 'type', 
#'                                   index = c("F", "G"),
#'                                   value = "3")
#' 
#' rwr_res <- random_walk_restart(X = graph1, 
#'                                seed = c("A", "B", "C", "D", "E"))
#' rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 
#'                                                   attribute = "type",
#'                                                   k = 3)
#' summary_plot_rwr_attributes(rwr_res_type)
#' 
#' 
#' @importFrom tibble rownames_to_column
#' @import ggplot2
#' @importFrom purrr imap_dfr set_names
#' @importFrom igraph vertex_attr
#' @importFrom dplyr filter mutate left_join group_by select summarise n
#' @export
summary_plot_rwr_attributes <- function(X, 
                                        color = NULL, 
                                        seed.id = NULL,
                                        seed.type = NULL, 
                                        plot = TRUE){
    stopifnot(is(X, "rwr.attributes") | is(X, "list.rwr.attributes"))
    
    # check seed.id
    seed.id <- check_vector_char(X = seed.id, 
                                 default = NULL,
                                 var.name = "'seed.id' ")
    
    # check seed.type
    seed.type <- check_vector_char(X = seed.type,
                                   default = NULL, 
                                   var.name = "'seed.type' ")
    
    # check color 
    if(!is.null(color)){
        color <- check_named_vector(X = color, var.name = "'color' ")
    }
    # check plot
    plot <- return_true_false(x = plot, default = TRUE)
    
    
    if(is(X, "rwr.attributes")){
        # seed type 
        seed_types <- purrr::imap_dfr(X, ~{vertex_attr(.x) %>% 
                as.data.frame() %>% dplyr::filter(rwr == "seed") %>% 
                dplyr::select(name, type) %>% 
                purrr::set_names(c("name", "seed.type"))})
        # count layer
        va.all <- purrr::imap_dfr(X, ~{igraph::vertex_attr(.x) %>% 
                as.data.frame() %>% 
                dplyr::mutate(seed = .y) %>% 
                dplyr::group_by(seed, type) %>% 
                dplyr::summarise(N = dplyr::n(), .groups = "keep")}) %>% 
            dplyr::left_join(seed_types, by = c("seed"="name"))
    } else { #X is list.rwr.attributes
        seed_types <- lapply(names(X), function(Y){
            purrr::imap_dfr(X[[Y]], ~{igraph::vertex_attr(.x) %>% 
                as.data.frame() %>% dplyr::filter(rwr == "seed") %>% 
                dplyr::select(name, type) %>% 
                    purrr::set_names(c("name", "seed.type"))}) %>% 
                dplyr::mutate(sub = Y)}) %>% do.call(what = "rbind")
        
        va.all <- lapply(names(X), function(Y){
            purrr::imap_dfr(X[[Y]], ~{vertex_attr(.x) %>% as.data.frame() %>% 
                    dplyr::mutate(seed = .y) %>% 
                    dplyr::group_by(seed, type) %>% 
                    dplyr::summarise(N = dplyr::n(), .groups = "keep")}) %>% 
                dplyr::mutate(sub = Y)
        }) %>% do.call(what = "rbind") %>%  
            dplyr::left_join(seed_types, by = c("seed"="name", "sub" = "sub"))
    }
    
    # filter seed.id
    if(!is.null(seed.id)){
        va.all <- va.all %>% dplyr::filter(seed %in% seed.id)
    }
    
    # filter seed.type
    if(!is.null(seed.type)){
        user.seed.type <- seed.type
        va.all <- dplyr::filter(va.all, seed.type %in% user.seed.type)
    }
    
    if(!nrow(va.all)){
        return(NULL)
    }
    
    # user color
    if(!is.null(color)){
        user.color <- as.list(color) %>% # named list/vector
            as.data.frame(check.names = FALSE) %>% 
            t %>% 
            as.data.frame(check.names = FALSE) %>% 
            tibble::rownames_to_column("type") %>% 
            purrr::set_names(c("type", "color"))
        
    } else { # color is NULL  -> defined color
        color.tmp <- va.all$type %>% unique %>%  sort()
        user.color <- mixOmics::color.mixo(seq(color.tmp)) %>% 
            purrr::set_names(color.tmp) %>% 
            as.data.frame(check.names = FALSE)  %>% 
            tibble::rownames_to_column("type") %>% 
            purrr::set_names(c("type", "color"))
    }

    # barplot
    # -----------
    gg.tmp <- ggplot2::ggplot(va.all, aes(x = seed, y = N, fill = type)) + 
        geom_bar(stat = "identity") +
        #scale_fill_identity(guide = "legend", labels = user.color$type) 
        scale_fill_manual(values = user.color$color) + 
        ylab("Node Types") + 
        xlab("Seeds") + 
        labs(fill = "Types") +
        theme_bw() +
        theme(axis.text.x = element_text(angle = 90, hjust=1))
    
    if(is(X, "list.rwr.attributes")){
        gg.tmp <- gg.tmp + facet_grid(.~sub, scales = "free_x")
    }
    if(plot == TRUE){
        print(gg.tmp)
    }
    return(invisible(gg.tmp))
}

#' Plot RWR subnetwork 
#'
#' Display the subgraph from a RWR results. This function colors adds a specific
#'  color to each node based on their 'type' attribute.
#' It also adds a legend including the number of vertices/edges and the number 
#' of nodes of specific type.
#' Additionally, the function can display any igraph object.
#' 
#' @param X an igraph object
#' @param color (optional) a named character vector or list, list of color
#'  to apply to each type
#' @param plot logical, if TRUE then the plot is produced
#' @param legend (optional) logical, if TRUE then the legend is displayed 
#' with number of veretices/edges and the number of nodes of specific type.
#' @param ... Arguments to be passed to the plot method
#' 
#' @return 
#' X is returned with additional vertex attributes
#' 
#' @examples
#' graph1 <- igraph::graph_from_data_frame(
#'     list(from = c("A", "B", "A", "D", "C", "A", "C"), 
#'          to = c("B", "C", "D", "E", "D", "F", "G")), 
#'     directed = FALSE)
#' graph1 <- igraph::set_vertex_attr(graph = graph1,
#'                                   name = 'type', 
#'                                   index = c("A","B","C"),
#'                                   value = "1")
#' graph1 <- igraph::set_vertex_attr(graph = graph1, 
#'                                   name = 'type', 
#'                                   index = c("D","E"),
#'                                   value = "2")
#' graph1 <- igraph::set_vertex_attr(graph = graph1, 
#'                                   name = 'type', 
#'                                   index = c("F", "G"),
#'                                   value = "3")
#' 
#' rwr_res <- random_walk_restart(X = graph1, 
#'                                seed = c("A"))
#' rwr_res_type <- rwr_find_seeds_between_attributes(X = rwr_res, 
#'                                                   attribute = "type")
#' 
#' plot_rwr_subnetwork(rwr_res_type$A)
#' 
#' 
#' @import ggplot2
#' @export
plot_rwr_subnetwork <- function(X,
                                color = NULL, 
                                plot = TRUE, 
                                legend = TRUE, 
                                ...){
    # check X
    stopifnot(is(X, "igraph"))
    
    # check color 
    if(!is.null(color)){
        color <- check_named_vector(X = color, 
                                    var.name = "'color' ")
    }

    # check plot
    plot <- return_true_false(x = plot, default = TRUE)
    legend <- return_true_false(x = legend, default = TRUE)
    
    
    va <- igraph::vertex_attr(X) %>% 
        as.data.frame()
    
    # user color
    if(!is.null(color)){
        user.color <- as.list(color) %>% # named list/vector
            as.data.frame(check.names = FALSE) %>%
            t %>% 
            as.data.frame(check.names = FALSE) %>% 
            tibble::rownames_to_column("type") %>% 
            purrr::set_names(c("type", "color"))
        
    } else { # color is NULL  -> defined color
        color.tmp <- va$type %>% unique %>%  sort()
        user.color <- mixOmics::color.mixo(seq(color.tmp)) %>% 
            purrr::set_names(color.tmp) %>% 
            as.data.frame(check.names = FALSE) %>% 
            tibble::rownames_to_column("type") %>% 
            purrr::set_names(c("type", "color"))
    }
    
    
    va <- va %>% dplyr::left_join(user.color, by = c("type" = "type"))
        #mutate(color = ifelse(rwr == "seed", 'red', color)) %>% 
    if('rwr' %in% names(va)){
        va <- va %>%
            mutate(shape = ifelse(rwr == "seed", 'rectangle', "circle")) %>%
            mutate(frame.color = ifelse(rwr == "seed", 'red', "black"))
    }
    
    igraph::vertex_attr(X) <- va
    
    # graph stats
    legend.graph.stats <- list(
        leg = c(paste0("V: ",c(igraph::vcount(X))), 
                paste0("E: ",c(igraph::ecount(X)))),
        pch = c(1, NA), lty = c(NA, 1))

    ## type
    legend.graph.type <- va %>% group_by(type) %>% summarise(N = dplyr::n()) %>%
        mutate(leg = paste0(type, ": ", N)) %>% 
        mutate(pch = c(19)) %>%
        left_join(user.color, by = c('type'))
    
    if(plot == TRUE){
        # plot(X, ...)
        plot(X)
        
        if(legend == TRUE){
            # legend.graph.stats
            legend("topleft", 
                   legend = legend.graph.stats$leg, 
                   pch = legend.graph.stats$pch, 
                   lty = legend.graph.stats$lty)
            
            # legend.graph.type
            legend("bottomleft", 
                   legend = legend.graph.type$leg, 
                   pch = legend.graph.type$pch,
                   col = legend.graph.type$color)
         
            if('rwr' %in% names(va)){
                title(main = va %>% filter(rwr == "seed") %>% pull(name))
            }
        }
    }
    return(X)
}