update decoding communities, calculating purity

Author: snaketron

ClustIRR.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: a0fc0d47-72cc-4280-89a1-60ae407db969
 
 RestoreWorkspace: Default
 SaveWorkspace: Default

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ClustIRR
 Type: Package
 Title: Clustering of immune receptor repertoires
-Version: 1.7.1
+Version: 1.7.3
 Authors@R: c(
     person("Simo", "Kitanovski", email = "simokitanovski@gmail.com", 
     role = c("aut", "cre"), comment=c(ORCID="0000-0003-2909-5376")),

NAMESPACE

@@ -68,7 +68,9 @@ export(get_beta_violins)
 export(get_beta_scatterplot)
 export(get_honeycombs)
 export(get_ag_summary)
-export(decode_communities)
+export(decode_community)
+export(decode_all_communities)
+export(get_community_purity)
 
 exportClasses(clust_irr)
 exportMethods(get_clustirr_clust)

R/clustirr.R

@@ -1,7 +1,7 @@
 clustirr <- function(s,
                      meta = NULL,
                      cores = 1,
-                     control = list(gmi = 0.7,
+                     control = list(gmi = 0.8,
                                     trim_flank_aa = 3,
                                     db_dist = 0,
                                     db_custom = NULL)) {

R/community.R

@@ -394,135 +394,6 @@ set_chain <- function(graph, chains) {
     return(graph)
 }
 
-# Description:
-# find components, cliques, subgraphs in a community
-decode_communities <- function(community_id,
-                               graph, 
-                               edge_filter,
-                               node_filter) {
-    
-    if(missing(edge_filter)) {
-        edge_filter <- NULL
-    }
-    if(missing(node_filter)) {
-        node_filter <- NULL
-    }
-    
-    apply_op <- function(vec, op, val) {
-        ops <- list("==" = `==`,
-                    "!=" = `!=`,
-                    "<"  = `<`,
-                    ">"  = `>`,
-                    "<=" = `<=`,
-                    ">=" = `>=`)
-        
-        if (!op %in% names(ops)) {
-            stop("Invalid operator, choose: '==', '!=', '<', '>', '<=', '>='")
-        }
-        
-        return(ops[[op]](vec, val))
-    }
-    
-    if(any(vertex_attr_names(graph)=="community")==FALSE) {
-        stop("no community ID as node attribute")
-    } else {
-        graph <- subgraph(graph = graph, 
-                          vids = V(graph)$community == community_id)
-    }
-    if(length(graph)==1 | length(E(graph)) == 0) {
-        warning("community has only one vertex")
-    }
-
-    # consider edges
-    if(is.null(edge_filter)==FALSE) {
-        # this is where the edge filter results will be kept
-        etm <- matrix(data = 0, 
-                      nrow = nrow(edge_filter), 
-                      ncol = length(E(graph)))
-        for(i in seq_len(nrow(edge_filter))) {
-            a_name <- edge_filter$name[i]
-            a_value <- edge_filter$value[i]
-            a_operation <- edge_filter$operation[i]
-            
-            j <- which(edge_attr_names(graph) == a_name)
-            if(length(j) != 0) {
-                v <- edge_attr(graph = graph, name = a_name)
-                etm[i,] <- apply_op(vec = v, val = a_value, op = a_operation)
-            }
-        }
-        etm <- apply(X = etm, MARGIN = 2, FUN = prod)
-        i <- which(etm == FALSE)
-        if(length(i) != 0) {
-            graph <- delete_edges(graph = graph, edges = i)
-        }
-    }
-    
-    # now partition based on node-attributes
-    if(is.null(node_filter)==FALSE) {
-        vs <- as_data_frame(x = graph, what = "vertices")
-        V(graph)$key <- apply(X = vs[, node_filter$name, drop=FALSE], 
-                              MARGIN = 1, FUN = paste, collapse = '|')
-        
-        sgs <- lapply(
-            X = unique(V(graph)$key), g = graph, 
-            FUN = function(x, g) {
-                # get a subgraph with shared node attributes
-                sg <- subgraph(graph = g, vids = which(V(g)$key == x))
-                
-                # find connected components
-                V(sg)$components <- components(graph = sg)$membership
-                V(sg)$component_id <- paste0(V(sg)$key, '|', 
-                                             V(sg)$components)
-                return(disjoint_union(lapply(
-                    X = unique(V(sg)$component_id), g = sg, 
-                    FUN = function(x, g) {
-                        vids <- which(V(g)$component_id == x)
-                        return(subgraph(graph = g, vids = vids))
-                    })))
-            })
-        sgs <- disjoint_union(sgs)
-        V(sgs)$component_id <- as.numeric(as.factor(V(sgs)$component_id))
-        
-        sgs_stat <- get_component_stats(x = sgs)
-        
-        vs <- as_data_frame(x = sgs, what = "vertices")
-        
-        return(list(community_graph = sgs, 
-                    component_stats = sgs_stat,
-                    node_summary = vs))
-    } 
-    else {
-        sgs <- lapply(
-            X = unique(V(graph)$community), g = graph, 
-            FUN = function(x, g) {
-                # get a subgraph with shared node attributes
-                sg <- subgraph(graph = g, vids = which(V(g)$community == x))
-                
-                # find connected components
-                V(sg)$components <- components(graph = sg)$membership
-                V(sg)$component_id <- paste0(V(sg)$community, '|', 
-                                             V(sg)$components)
-                V(sg)$component_id <- as.numeric(as.factor(V(sg)$component_id))
-                return(disjoint_union(lapply(
-                    X = unique(V(sg)$component_id), g = sg, 
-                    FUN = function(x, g) {
-                        vids <- which(V(g)$component_id == x)
-                        return(subgraph(graph = g, vids = vids))
-                    })))
-            })
-        sgs <- disjoint_union(sgs)
-        
-        sgs_stat <- get_component_stats(x = sgs)
-        
-        vs <- as_data_frame(x = sgs, what = "vertices")
-        
-        return(list(community_graph = sgs, 
-                    component_stats = sgs_stat,
-                    node_summary = vs))
-    }
-}
-
-
 get_component_stats <- function(x) {
 
     # what is he
@@ -574,4 +445,3 @@ get_component_stats <- function(x) {
 
     return(rbind(stats_components, stats_singletons))
 }
-