├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS ├── R ├── ggkegg.R ├── highlight_functions.R ├── module_functions.R ├── network_functions.R ├── overlay_functions.R ├── pathway_functions.R ├── plot_functions.R ├── stamp.R └── utils.R ├── README.Rmd ├── README.md ├── inst └── CITATION ├── man ├── add_title.Rd ├── append_cp.Rd ├── append_label_position.Rd ├── assign_deseq2.Rd ├── carrow.Rd ├── combine_with_bnlearn.Rd ├── convert_id.Rd ├── create_test_module.Rd ├── create_test_network.Rd ├── create_test_pathway.Rd ├── edge_matrix.Rd ├── edge_numeric.Rd ├── edge_numeric_sum.Rd ├── figures │ ├── README-unnamed-chunk-3-1.png │ ├── README-unnamed-chunk-4-1.png │ └── README-unnamed-chunk-5-1.png ├── geom_kegg.Rd ├── geom_node_rect.Rd ├── geom_node_rect_kegg.Rd ├── geom_node_rect_multi.Rd ├── geom_node_shadowtext.Rd ├── get_module_attribute-kegg_module-method.Rd ├── get_module_attribute.Rd ├── get_network_attribute-kegg_network-method.Rd ├── get_network_attribute.Rd ├── ggkegg.Rd ├── ggkeggsave.Rd ├── ggplot_add.geom_kegg.Rd ├── ggplot_add.geom_node_rect_kegg.Rd ├── ggplot_add.geom_node_rect_multi.Rd ├── ggplot_add.overlay_raw_map.Rd ├── ggplot_add.stamp.Rd ├── highlight_entities.Rd ├── highlight_module.Rd ├── highlight_set_edges.Rd ├── highlight_set_nodes.Rd ├── module.Rd ├── module_abundance.Rd ├── module_completeness.Rd ├── module_text.Rd ├── multi_pathway_native.Rd ├── network.Rd ├── network_graph.Rd ├── node_matrix.Rd ├── node_numeric.Rd ├── obtain_sequential_module_definition.Rd ├── output_overlay_image.Rd ├── overlay_raw_map.Rd ├── pathway.Rd ├── pathway_abundance.Rd ├── pathway_info.Rd ├── plot_kegg_network.Rd ├── plot_module_blocks.Rd ├── plot_module_text.Rd ├── process_line.Rd ├── process_reaction.Rd ├── rawMap.Rd ├── rawValue.Rd ├── return_line_compounds.Rd └── stamp.Rd ├── tests ├── testthat.R └── testthat │ ├── test-highlight.R │ ├── test-module.R │ ├── test-network.R │ ├── test-pathway.R │ └── test-utils.R └── vignettes └── usage_of_ggkegg.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\.github$ 2 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 17 | steps: 18 | - uses: actions/checkout@v3 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::rcmdcheck 27 | needs: check 28 | 29 | - uses: r-lib/actions/check-r-package@v2 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.xml 2 | *BiocCheck 3 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggkegg 2 | Type: Package 3 | Title: Analyzing and visualizing KEGG information using the grammar of graphics 4 | Version: 1.4.1 5 | Authors@R: person("Noriaki", "Sato", email = "nori@hgc.jp", role = c("cre", "aut")) 6 | Description: This package aims to import, parse, and analyze KEGG data such as KEGG PATHWAY and KEGG MODULE. The package supports visualizing KEGG information using ggplot2 and ggraph through using the grammar of graphics. The package enables the direct visualization of the results from various omics analysis packages. 7 | License: MIT + file LICENSE 8 | Encoding: UTF-8 9 | Depends: 10 | R (>= 4.3.0), ggplot2, ggraph, XML, igraph, tidygraph 11 | Imports: BiocFileCache, data.table, dplyr, 12 | magick, patchwork, shadowtext, stringr, tibble, 13 | methods, utils, stats, grDevices, gtable 14 | Suggests: 15 | knitr, 16 | clusterProfiler, 17 | bnlearn, 18 | rmarkdown, 19 | BiocStyle, 20 | AnnotationDbi, 21 | testthat (>= 3.0.0) 22 | RoxygenNote: 7.3.2 23 | biocViews: Pathways, DataImport, KEGG 24 | VignetteBuilder: knitr 25 | URL: https://github.com/noriakis/ggkegg 26 | BugReports: https://github.com/noriakis/ggkegg/issues 27 | Config/testthat/edition: 3 28 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 noriakis 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(ggplot_add,geom_kegg) 4 | S3method(ggplot_add,geom_node_rect_kegg) 5 | S3method(ggplot_add,geom_node_rect_multi) 6 | S3method(ggplot_add,overlay_raw_map) 7 | S3method(ggplot_add,stamp) 8 | export(add_title) 9 | export(append_cp) 10 | export(append_label_position) 11 | export(assign_deseq2) 12 | export(carrow) 13 | export(combine_with_bnlearn) 14 | export(convert_id) 15 | export(create_test_module) 16 | export(create_test_network) 17 | export(create_test_pathway) 18 | export(edge_matrix) 19 | export(edge_numeric) 20 | export(edge_numeric_sum) 21 | export(geom_kegg) 22 | export(geom_node_rect) 23 | export(geom_node_rect_kegg) 24 | export(geom_node_rect_multi) 25 | export(geom_node_shadowtext) 26 | export(get_module_attribute) 27 | export(get_network_attribute) 28 | export(ggkegg) 29 | export(ggkeggsave) 30 | export(ggplot_add.geom_kegg) 31 | export(ggplot_add.geom_node_rect_kegg) 32 | export(ggplot_add.geom_node_rect_multi) 33 | export(ggplot_add.overlay_raw_map) 34 | export(highlight_entities) 35 | export(highlight_module) 36 | export(highlight_set_edges) 37 | export(highlight_set_nodes) 38 | export(module) 39 | export(module_abundance) 40 | export(module_completeness) 41 | export(module_text) 42 | export(multi_pathway_native) 43 | export(network) 44 | export(network_graph) 45 | export(node_matrix) 46 | export(node_numeric) 47 | export(obtain_sequential_module_definition) 48 | export(output_overlay_image) 49 | export(overlay_raw_map) 50 | export(pathway) 51 | export(pathway_abundance) 52 | export(pathway_info) 53 | export(plot_kegg_network) 54 | export(plot_module_blocks) 55 | export(plot_module_text) 56 | export(process_line) 57 | export(process_reaction) 58 | export(rawMap) 59 | export(rawValue) 60 | export(return_line_compounds) 61 | export(stamp) 62 | import(BiocFileCache) 63 | import(ggplot2) 64 | import(ggraph) 65 | import(gtable) 66 | import(igraph) 67 | import(magick) 68 | import(patchwork) 69 | importFrom(XML,getNodeSet) 70 | importFrom(XML,xmlApply) 71 | importFrom(XML,xmlAttrs) 72 | importFrom(XML,xmlElementsByTagName) 73 | importFrom(XML,xmlParse) 74 | importFrom(data.table,":=") 75 | importFrom(data.table,fread) 76 | importFrom(dplyr,distinct) 77 | importFrom(dplyr,filter) 78 | importFrom(dplyr,group_by) 79 | importFrom(dplyr,mutate) 80 | importFrom(dplyr,n) 81 | importFrom(dplyr,row_number) 82 | importFrom(dplyr,summarise) 83 | importFrom(dplyr,tibble) 84 | importFrom(dplyr,ungroup) 85 | importFrom(grDevices,as.raster) 86 | importFrom(grDevices,dev.off) 87 | importFrom(grDevices,png) 88 | importFrom(igraph,delete_vertex_attr) 89 | importFrom(igraph,graph_from_data_frame) 90 | importFrom(igraph,induced.subgraph) 91 | importFrom(methods,new) 92 | importFrom(shadowtext,GeomShadowText) 93 | importFrom(stats,setNames) 94 | importFrom(stats,weighted.mean) 95 | importFrom(stringr,str_extract) 96 | importFrom(stringr,str_extract_all) 97 | importFrom(stringr,str_locate_all) 98 | importFrom(stringr,str_pad) 99 | importFrom(tibble,as_tibble) 100 | importFrom(tibble,is_tibble) 101 | importFrom(tidygraph,.G) 102 | importFrom(tidygraph,activate) 103 | importFrom(tidygraph,as_tbl_graph) 104 | importFrom(tidygraph,bind_edges) 105 | importFrom(tidygraph,bind_nodes) 106 | importFrom(tidygraph,graph_join) 107 | importFrom(tidygraph,tbl_graph) 108 | importFrom(utils,download.file) 109 | importFrom(utils,head) 110 | importFrom(utils,tail) 111 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | Changes in version 1.1.17 (2024-04-06) 2 | + stamp function 3 | + Make some colors non-default in overlay_raw_map 4 | Changes in version 0.99.3 (2023-08-25) 5 | + Added new files 6 | Changes in version 0.99.2 (2023-08-25) 7 | + Remove the unnecessary file to pass R CMD CHECK 8 | Changes in version 0.99.1 (2023-08-25) 9 | + Revising the codes based on the Bioconductor review 10 | Changes in version 0.99.0 (2023-06-27) 11 | + Submitted to Bioconductor -------------------------------------------------------------------------------- /R/ggkegg.R: -------------------------------------------------------------------------------- 1 | #' ggkegg 2 | #' 3 | #' main function parsing KEGG pathway data, 4 | #' making igraph object and passing it to ggraph. 5 | #' 6 | #' @param pid KEGG Pathway id e.g. hsa04110 7 | #' @param pathway_number pathway number if passing enrichResult 8 | #' @param layout default to "native", using KGML positions 9 | #' @param return_igraph return the resulting igraph object 10 | #' @param return_tbl_graph return the resulting tbl_graph object 11 | #' (override `return_igraph` argument) 12 | #' @param delete_undefined delete the undefined nodes from graph 13 | #' default to FALSE, which preserves nodes but 14 | #' add `undefined` attribute to graph 15 | #' @param convert_org these organism names are fetched from REST API 16 | #' and cached, and used to convert the KEGG identifiers. 17 | #' e.g. c("hsa", "compound") 18 | #' @param convert_first after converting, take the first element as 19 | #' node name when multiple genes are listed in the node 20 | #' @param convert_collapse if not NULL, collapse 21 | #' the gene names by this character 22 | #' when multiple genes are listed in the node. 23 | #' @param convert_reaction reaction name (graph attribute `reaction`) 24 | #' will be converted to reaction formula 25 | #' @param delete_undefined delete `undefined` node specifying group, 26 | #' should be set to `TRUE` when the layout is not from native KGML. 27 | #' @param delete_zero_degree delete nodes with zero degree, 28 | #' default to FALSE 29 | #' @param module_type specify which module attributes to obtain 30 | #' (definition or reaction) 31 | #' @param module_definition_type `text` or `network` 32 | #' when parsing module definition. 33 | #' If `text`, return ggplot object. If `network`, return `tbl_graph`. 34 | #' @param numeric_attribute named vector for appending numeric attribute 35 | #' @param node_rect_nudge parameter for nudging the node rect 36 | #' @param group_rect_nudge parameter for nudging the group node rect 37 | #' @examples 38 | #' ## Use pathway ID to obtain `ggraph` object directly. 39 | #' g <- ggkegg("hsa04110") 40 | #' g + geom_node_rect() 41 | #' @import ggraph 42 | #' @import ggplot2 43 | #' @importFrom tidygraph as_tbl_graph 44 | #' @importFrom igraph induced.subgraph delete_vertex_attr 45 | #' @importFrom methods new 46 | #' @export 47 | #' @return ggplot2 object 48 | ggkegg <- function(pid, 49 | layout="native", 50 | return_igraph=FALSE, 51 | return_tbl_graph=FALSE, 52 | pathway_number=1, 53 | convert_org=NULL, 54 | convert_first=TRUE, 55 | convert_collapse=NULL, 56 | convert_reaction=FALSE, 57 | delete_undefined=FALSE, 58 | delete_zero_degree=FALSE, 59 | numeric_attribute=NULL, 60 | node_rect_nudge=0, 61 | group_rect_nudge=2, 62 | module_type="definition", 63 | module_definition_type="text") { 64 | 65 | if (!is.character(pid)) { 66 | if (attributes(pid)$class == "enrichResult") { 67 | org <- attributes(pid)$organism 68 | res <- attributes(pid)$result 69 | if (org != "UNKNOWN") { 70 | enrich_attribute <- paste0(org, 71 | ":", 72 | unlist(strsplit(res[pathway_number,]$geneID, "/")) 73 | ) 74 | } else { 75 | enrich_attribute <- unlist( 76 | strsplit(res[pathway_number,]$geneID, "/") 77 | ) 78 | } 79 | pid <- res[pathway_number,]$ID 80 | } 81 | } else { 82 | enrich_attribute <- NULL 83 | } 84 | 85 | 86 | if (is.character(pid)) { 87 | if (startsWith(pid, "M")) { 88 | mod <- module(pid) 89 | if (module_type == "definition") { 90 | if (module_definition_type == "text") { 91 | plot_list <- module_text(mod, candidate_ko=enrich_attribute) 92 | return(plot_module_text(plot_list)) 93 | } else if (module_definition_type == "network") { 94 | return(obtain_sequential_module_definition(mod)) 95 | } else { 96 | stop("Please specify `network` or `text`", 97 | " to module_definition_type") 98 | } 99 | } else if (module_type == "reaction") { 100 | return(mod@reaction_graph) 101 | } else { 102 | stop("Please specify `reaction` or `definition`", 103 | " to module_type") 104 | } 105 | } 106 | if (startsWith(pid, "N")) { 107 | network <- network(pid) 108 | return(network |> network_graph() |> plot_kegg_network()) 109 | } 110 | } 111 | ## If not module or enrichResult, return pathway 112 | g <- pathway(pid=pid, 113 | node_rect_nudge=node_rect_nudge, 114 | group_rect_nudge=group_rect_nudge, 115 | return_tbl_graph=FALSE) 116 | 117 | ## This part may be redundant, use `convert_id` 118 | if (!is.null(convert_org)) { 119 | convert_vec <- lapply(convert_org, function(co) { 120 | obtain_map_and_cache(co, pid) 121 | }) |> unlist() 122 | 123 | V(g)$converted_name <- unlist(lapply(V(g)$name, 124 | function(x) { 125 | inc_genes <- unlist(strsplit(x, " ")) 126 | conv_genes <- vapply(inc_genes, function(inc) { 127 | convs <- convert_vec[inc] 128 | if (is.na(convs)) { 129 | return(x) 130 | } else { 131 | return(convs) 132 | } 133 | }, FUN.VALUE="a") 134 | if (convert_first) { 135 | conv_genes[1] 136 | } else { 137 | paste(conv_genes, collapse=convert_collapse) 138 | } 139 | } 140 | )) 141 | } 142 | 143 | if (!is.null(numeric_attribute)){ 144 | V(g)$numeric_attribute <- numeric_attribute[V(g)$name] 145 | } 146 | 147 | if (!is.null(enrich_attribute)) { 148 | bools <- vapply(V(g)$name, function(xx) { 149 | in_node <- strsplit(xx, " ") |> unlist() |> unique() 150 | if (length(intersect(in_node, enrich_attribute)) >= 1) { 151 | return(TRUE) 152 | } else { 153 | return(FALSE) 154 | } 155 | }, FUN.VALUE=TRUE) 156 | V(g)$enrich_attribute <- bools 157 | } 158 | 159 | if (delete_undefined) { 160 | g <- induced.subgraph(g, !V(g)$name %in% "undefined") 161 | } else { 162 | V(g)$undefined <- V(g)$name %in% "undefined" 163 | } 164 | if (delete_zero_degree) { 165 | g <- induced.subgraph(g, degree(g)!=0) 166 | } 167 | 168 | if (convert_reaction) { 169 | convert_vec <- obtain_map_and_cache("reaction",NULL) 170 | V(g)$converted_reaction <- unlist(lapply(V(g)$reaction, 171 | function(x) { 172 | inc_genes <- unlist(strsplit(x, " ")) 173 | conv_genes <- vapply(inc_genes, function(inc) { 174 | convs <- convert_vec[inc] 175 | if (is.na(convs)) { 176 | return(x) 177 | } else { 178 | return(convs) 179 | } 180 | }, FUN.VALUE="a") 181 | if (convert_first) { 182 | conv_genes[1] 183 | } else { 184 | paste(conv_genes, collapse=convert_collapse) 185 | } 186 | } 187 | )) 188 | } 189 | 190 | if (return_tbl_graph) { 191 | return(as_tbl_graph(g)) 192 | } 193 | if (return_igraph) { 194 | return(g) 195 | } 196 | if (layout == "native") { 197 | ggraph(g, layout="manual", x=.data$x, y=.data$y) 198 | } else { 199 | g <- delete_vertex_attr(g, "x") 200 | g <- delete_vertex_attr(g, "y") 201 | ggraph(g, layout=layout) 202 | } 203 | } 204 | 205 | 206 | #' rawMap 207 | #' 208 | #' given enrichResult class object, 209 | #' return the ggplot object with raw KEGG map overlaid on 210 | #' enriched pathway. Can be used with the function such as 211 | #' `clusterProfiler::enrichKEGG` and `MicrobiomeProfiler::enrichKO()` 212 | #' 213 | #' @param enrich enrichResult or gseaResult class object, or list of them 214 | #' @param pathway_number pathway number sorted by p-values 215 | #' @param pid pathway id, override pathway_number if specified 216 | #' @param fill_color color for genes 217 | #' @param white_background fill background color white 218 | #' @param how how to match the node IDs with the queries 'any' or 'all' 219 | #' @param infer if TRUE, append the prefix to queried IDs based on pathway ID 220 | #' @param name name of column to match for 221 | #' @param sep separater for name, default to " " 222 | #' @param remove_dot remove "..." in the name 223 | #' @export 224 | #' @examples 225 | #' if (require("clusterProfiler")) { 226 | #' cp <- enrichKEGG(c("1029","4171")) 227 | #' ## Multiple class object can be passed by list 228 | #' rawMap(list(cp,cp), pid="hsa04110") 229 | #' } 230 | #' @return ggraph with overlaid KEGG map 231 | #' 232 | rawMap <- function(enrich, pathway_number=1, pid=NULL, 233 | fill_color="red", how="any", white_background=TRUE, infer=FALSE, 234 | name="name", sep=" ", remove_dot=TRUE) { 235 | 236 | number <- length(enrich) 237 | if (length(fill_color) != number) { 238 | cat("Length of fill_color and enrich mismatches,", 239 | "taking first color\n") 240 | fill_color <- rep(fill_color[1], number) 241 | } 242 | if (is.list(enrich)) { 243 | if (is.null(pid)) {stop("Please specify pathway id.")} 244 | } else { 245 | if (attributes(enrich)$class == "enrichResult") { 246 | res <- attributes(enrich)$result 247 | if (is.null(pid)) { 248 | pid <- res[pathway_number, ]$ID 249 | } 250 | } else if (attributes(enrich)$class == "gseaResult") { 251 | res <- attributes(enrich)$result 252 | if (is.null(pid)) { 253 | pid <- res[pathway_number, ]$ID 254 | } 255 | } else { 256 | stop("Please provide enrichResult") 257 | } 258 | } 259 | ## For MicrobiomeProfiler 260 | if (startsWith(pid, "map")) { 261 | cat("Changing prefix of pathway ID from map to ko\n") 262 | pid <- gsub("map","ko",pid) 263 | } 264 | if (number == 1) { 265 | g <- pathway(pid) %>% mutate(cp=append_cp(!!enrich, how=!!how, pid=!!pid, infer=!!infer, 266 | name=!!name, sep=!!sep, remove_dot=!!remove_dot)) 267 | gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y)+ 268 | geom_node_rect(fill=fill_color, aes(filter=.data$cp))+ 269 | overlay_raw_map()+theme_void() 270 | } else { 271 | g <- pathway(pid) 272 | for (i in seq_len(number)) { 273 | g <- g |> mutate(!!paste0("cp",i) :=append_cp(enrich[[i]], 274 | how=!!how, pid=!!pid, infer=!!infer, name=!!name, sep=!!sep, remove_dot=!!remove_dot)) 275 | } 276 | V(g)$space <- V(g)$width/number 277 | gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y) 278 | nds <- g |> activate("nodes") |> data.frame() 279 | for (i in seq_len(number)) { 280 | gg <- gg + 281 | geom_node_rect(fill=fill_color[i], 282 | data=nds[nds[[paste0("cp",i)]], ], 283 | xmin=nds[nds[[paste0("cp",i)]], ]$xmin+ 284 | nds[nds[[paste0("cp",i)]], ]$space*(i-1) 285 | ) 286 | } 287 | gg <- gg + overlay_raw_map()+theme_void() 288 | } 289 | if (white_background) { 290 | gg + theme(panel.background=element_rect(fill='white', colour='white')) 291 | } else { 292 | gg 293 | } 294 | } 295 | 296 | 297 | 298 | #' rawValue 299 | #' 300 | #' given named vector of quantitative values, 301 | #' return the ggplot object with raw KEGG map overlaid. 302 | #' Colors can be changed afterwards. 303 | #' 304 | #' @param values named vector, or list of them 305 | #' @param pid pathway id 306 | #' @param white_background fill background color white 307 | #' @param how how to match the node IDs with the queries 'any' or 'all' 308 | #' @param auto_add automatically add prefix based on pathway prefix 309 | #' @param man_graph provide manual tbl_graph 310 | #' @param show_type type to be shown 311 | #' @param column name of column to match for 312 | #' @param sep separater for name, default to " " 313 | #' @param remove_dot remove "..." in the name 314 | #' typically, "gene", "ortholog", or "compound" 315 | #' @export 316 | #' @examples 317 | #' ## Colorize by passing the named vector of numeric values 318 | #' rv <- rawValue(c(1.1) |> setNames("hsa:6737"), 319 | #' man_graph=create_test_pathway()) 320 | #' @return ggraph with overlaid KEGG map 321 | #' 322 | rawValue <- function(values, pid=NULL, column="name", show_type="gene", 323 | how="any", white_background=TRUE, auto_add=FALSE, man_graph=NULL, 324 | sep=" ", remove_dot=TRUE) { 325 | if (is.list(values)) { 326 | number <- length(values) 327 | if (auto_add) { 328 | pref <- gsub("[^a-zA-Z]", "", pid) 329 | for (i in seq_along(values)) { 330 | names(values[[i]]) <- paste0(pref, ":", names(values[[i]])) 331 | } 332 | } 333 | } else { 334 | number <- 1 335 | if (auto_add) { 336 | pref <- gsub("[^a-zA-Z]", "", pid) 337 | names(values) <- paste0(pref, ":", names(values)) 338 | } 339 | } 340 | if (!is.null(man_graph)) { 341 | pgraph <- man_graph 342 | } else { 343 | pgraph <- pathway(pid) 344 | } 345 | if (number == 1) { 346 | g <- pgraph |> mutate(value=node_numeric(values, 347 | name=column, how=how, sep=sep, remove_dot=remove_dot)) 348 | gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y)+ 349 | geom_node_rect(aes(fill=.data$value, 350 | filter=.data$type %in% show_type))+ 351 | overlay_raw_map()+theme_void() 352 | } else { 353 | ## Add new scales like ggh4x 354 | g <- pgraph 355 | for (i in seq_len(number)) { 356 | g <- g |> mutate(!!paste0("value",i):=node_numeric(values[[i]], 357 | name=column,how=how)) 358 | } 359 | V(g)$space <- V(g)$width/number 360 | gg <- ggraph(g, layout="manual", x=.data$x, y=.data$y) 361 | nds <- g |> activate("nodes") |> data.frame() 362 | nds <- nds[nds$type %in% show_type,] 363 | 364 | for (i in seq_len(number)) { 365 | nudge <- i-1 366 | 367 | gg <- gg + geom_node_rect( 368 | aes(fill=!!sym(paste0("value",i)), 369 | filter=.data$type %in% show_type), 370 | xmin=nds$xmin+nds$space*nudge, 371 | xmax=nds$xmin+i*nds$space 372 | ) 373 | } 374 | gg <- gg + overlay_raw_map()+theme_void() 375 | } 376 | if (white_background) { 377 | gg + theme(panel.background=element_rect(fill='white', colour='white')) 378 | } else { 379 | gg 380 | } 381 | } -------------------------------------------------------------------------------- /R/highlight_functions.R: -------------------------------------------------------------------------------- 1 | #' highlight_entities 2 | #' 3 | #' highlight the entities in the pathway, 4 | #' overlay raw map and return the results. 5 | #' Note that highlighted nodes are considered to be rectangular, 6 | #' so it is not compatible with the type like `compound`. 7 | #' 8 | #' @param pathway pathway ID to be passed to `pathway()` 9 | #' @param set vector of identifiers, or named vector of numeric values 10 | #' @param num_combine combining function if multiple hits are obtained per node 11 | #' @param how if `all`, if node contains multiple 12 | #' IDs separated by `sep`, highlight if all the IDs 13 | #' are in query. if `any`, highlight if one of the IDs 14 | #' is in query. 15 | #' @param name which column to search for 16 | #' @param sep separater for node names 17 | #' @param no_sep not separate node name 18 | #' @param show_type entitie type, default to 'gene' 19 | #' @param fill_color highlight color, default to 'tomato' 20 | #' @param legend_name legend name, NULL to suppress 21 | #' @param use_cache use cache or not 22 | #' @param return_graph return tbl_graph instead of plot 23 | #' @param remove_dot remove the "..." in the graphics name column 24 | #' @param directory directroy with XML files. ignore caching when specified. 25 | #' @return overlaid map 26 | #' @examples 27 | #' highlight_entities("hsa04110", c("CDKN2A"), legend_name="interesting") 28 | #' @export 29 | #' 30 | highlight_entities <- function(pathway, set, how="any", 31 | num_combine=mean, name="graphics_name", sep=", ", no_sep=FALSE, 32 | show_type="gene", fill_color="tomato", remove_dot=TRUE, 33 | legend_name=NULL, use_cache=FALSE, return_graph=FALSE, directory=NULL) { 34 | graph <- pathway(pathway, use_cache=use_cache, directory=directory) 35 | x <- get.vertex.attribute(graph, name) 36 | 37 | if (is.null(names(set))) {## Discrete 38 | vec <- vapply(seq_along(x), function(xn) { 39 | if (no_sep) { 40 | nn <- x[xn] 41 | } else { 42 | nn <- unlist(strsplit(x[xn], sep)) |> unique() 43 | } 44 | if (remove_dot) { 45 | nn <- strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 46 | } 47 | if (how == "all") { 48 | if (length(intersect(nn, set)) == length(nn)) { 49 | return(TRUE) 50 | } else { 51 | return(FALSE) 52 | } 53 | } else { 54 | if (length(intersect(nn, set)) >= 1) { 55 | return(TRUE) 56 | } else { 57 | return(FALSE) 58 | } 59 | } 60 | }, FUN.VALUE=TRUE) 61 | graph <- graph |> mutate(highlight=vec) 62 | if (return_graph) {return(graph)} 63 | res <- ggraph(graph, layout="manual", x=.data$x, y=.data$y) + 64 | geom_node_rect(aes(filter=.data$type %in% show_type, 65 | fill=.data$highlight))+ 66 | scale_fill_manual(values=c("grey", fill_color), name=legend_name)+ 67 | overlay_raw_map()+ 68 | theme_void() 69 | if (is.null(legend_name)) { 70 | res <- res + theme(legend.position="none") 71 | } 72 | } else {## Numeric 73 | vec <- lapply(seq_along(x), function(xn) { 74 | if (no_sep) { 75 | nn <- x[xn] 76 | } else { 77 | nn <- unlist(strsplit(x[xn], sep)) |> unique() 78 | } 79 | if (remove_dot) { 80 | nn <- strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 81 | } 82 | thresh <- ifelse(how=="any", 1, length(nn)) 83 | if (length(intersect(names(set), nn)) >= thresh) { 84 | summed <- do.call(num_combine, 85 | list(x=set[intersect(names(set), nn)])) 86 | } else { 87 | summed <- NA 88 | } 89 | }) |> unlist() 90 | graph <- graph |> mutate(highlight=vec) 91 | if (return_graph) {return(graph)} 92 | res <- ggraph(graph, layout="manual", x=.data$x, y=.data$y) + 93 | geom_node_rect(aes(filter=.data$type %in% show_type, 94 | fill=.data$highlight))+ 95 | scale_fill_continuous(name=legend_name)+ 96 | overlay_raw_map()+ 97 | theme_void() 98 | if (is.null(legend_name)) { 99 | res <- res + theme(legend.position="none") 100 | } 101 | } 102 | return(res) 103 | } 104 | 105 | 106 | 107 | #' highlight_set_nodes 108 | #' 109 | #' identify if nodes are involved in specific queriy. 110 | #' if multiple IDs are listed after separation by `sep`, 111 | #' only return TRUE if all the IDs are in the query. 112 | #' 113 | #' @param set set of identifiers 114 | #' @param how if `all`, if node contains multiple 115 | #' IDs separated by `sep`, highlight if all the IDs 116 | #' are in query. if `any`, highlight if one of the IDs 117 | #' is in query. 118 | #' @param name which column to search for 119 | #' @param sep separater for node names 120 | #' @param no_sep not separate node name 121 | #' @param remove_dot remove "..." after graphics name column 122 | #' @export 123 | #' @return boolean vector 124 | #' @examples 125 | #' graph <- create_test_pathway() 126 | #' ## Highlight set of nodes by specifying ID 127 | #' graph <- graph |> mutate(hl=highlight_set_nodes(c("hsa:51428"))) 128 | #' 129 | #' ## node column can be specified by `name` argument 130 | #' graph <- graph |> 131 | #' mutate(hl=highlight_set_nodes(c("DDX41"), name="graphics_name")) 132 | highlight_set_nodes <- function(set, how="all", 133 | name="name", sep=" ", no_sep=FALSE, remove_dot=TRUE) { 134 | graph <- .G() 135 | x <- get.vertex.attribute(graph, name) 136 | vec <- vapply(seq_along(x), function(xn) { 137 | if (no_sep) { 138 | nn <- x[xn] 139 | } else { 140 | nn <- unlist(strsplit(x[xn], sep)) 141 | } 142 | if (remove_dot) { 143 | nn <- strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 144 | } 145 | if (how == "all") { 146 | if (length(intersect(nn, set)) == length(nn)) { 147 | return(TRUE) 148 | } else { 149 | return(FALSE) 150 | } 151 | } else { 152 | if (length(intersect(nn, set)) >= 1) { 153 | return(TRUE) 154 | } else { 155 | return(FALSE) 156 | } 157 | } 158 | }, FUN.VALUE=TRUE) 159 | if (length(unique(vec))==1) { 160 | cat("None of the nodes (or all the nodes) was highlighted.\n") 161 | } 162 | vec 163 | } 164 | 165 | 166 | #' highlight_set_edges 167 | #' 168 | #' identify if edges are involved in specific query. 169 | #' if multiple IDs are listed after separation by `sep`, 170 | #' only return TRUE if all the IDs are in the query. 171 | #' 172 | #' @param set set of identifiers 173 | #' @param how if `all`, if node contains multiple 174 | #' IDs separated by `sep`, highlight if all the IDs 175 | #' are in query. if `any`, highlight if one of the IDs 176 | #' is in query. 177 | #' @param name which column to search for 178 | #' @param sep separater for node names 179 | #' @param no_sep not separate node name 180 | #' @export 181 | #' @return boolean vector 182 | #' @examples 183 | #' graph <- create_test_pathway() 184 | #' 185 | #' ## Specify edge column by `name` 186 | #' ## In this example, edges having `degradation` value in 187 | #' ## `subtype_name` column will be highlighted 188 | #' graph <- graph |> activate("edges") |> 189 | #' mutate(hl=highlight_set_edges(c("degradation"), name="subtype_name")) 190 | #' 191 | highlight_set_edges <- function(set, how="all", 192 | name="name", sep=" ", no_sep=FALSE) { 193 | graph <- .G() 194 | x <- get.edge.attribute(graph, name) 195 | vec <- vapply(seq_along(x), function(xn) { 196 | if (no_sep) { 197 | nn <- x[xn] 198 | } else { 199 | nn <- unlist(strsplit(x[xn], sep)) 200 | } 201 | if (how == "all") { 202 | if (length(intersect(nn, set)) == length(nn)) { 203 | return(TRUE) 204 | } else { 205 | return(FALSE) 206 | } 207 | } else { 208 | if (length(intersect(nn, set)) >= 1) { 209 | return(TRUE) 210 | } else { 211 | return(FALSE) 212 | } 213 | } 214 | }, FUN.VALUE=TRUE) 215 | vec 216 | } 217 | 218 | 219 | #' highlight_module 220 | #' 221 | #' identify if edges are involved in module reaction, and whether 222 | #' linked compounds are involved in the reaction. It would not be exactly 223 | #' the same as KEGG mapper. For instance, `R04293` involved in `M00912` 224 | #' is not included in KGML of `ko01100`. 225 | #' 226 | #' @param graph tbl_graph 227 | #' @param kmo kegg_module class object which stores reaction 228 | #' @param name which column to search for 229 | #' @param sep separator for node names 230 | #' @param verbose show messages or not 231 | #' @importFrom data.table := 232 | #' @export 233 | #' @return boolean vector 234 | #' @examples 235 | #' ## Highlight module within the pathway 236 | #' graph <- create_test_pathway() 237 | #' mo <- create_test_module() 238 | #' graph <- graph |> highlight_module(mo) 239 | #' 240 | highlight_module <- function(graph, kmo, 241 | name="name", 242 | sep=" ", 243 | verbose=FALSE) { 244 | if (attributes(kmo)$class[1] != "kegg_module") { 245 | stop("Please provide kegg_module class object") 246 | } 247 | 248 | edge_df <- graph |> activate("edges") |> data.frame() 249 | node_df <- graph |> activate("nodes") |> data.frame() 250 | 251 | ## First identify edges of reaction 252 | einds <- rep(FALSE, E(graph) |> length()) 253 | ninds <- rep(FALSE, V(graph) |> length()) 254 | 255 | ## Obtain each raw reaction 256 | rea <- kmo@reaction_each_raw 257 | results <- lapply(seq_len(nrow(kmo@reaction_each_raw)), function(i) { 258 | left <- kmo@reaction_each[i,][1] |> 259 | unlist() |> as.character() |> paste0("cpd:", ...=_) 260 | raw_reac_string <- rea[i,][2] |> 261 | unlist() |> as.character() 262 | reac_list <- kmo@reaction_each[i,][2] |> unlist() |> as.character() 263 | right <- kmo@reaction_each[i,][3] |> 264 | unlist() |> as.character() |> paste0("cpd:", ...=_) 265 | if (verbose) {cat("Checking reaction:", raw_reac_string, "\n")} 266 | 267 | x <- get.edge.attribute(graph, "reaction") 268 | ## Store edge index that meet reaction 269 | ind <- lapply(seq_along(x), function(xn) { 270 | reac <- raw_reac_string 271 | rls <- rep(FALSE, length(reac_list)) 272 | names(rls) <- reac_list 273 | ## reactions associated with the edge 274 | edge_reac <- x[xn] |> strsplit(" ") |> unlist() 275 | if (sum(is.na(edge_reac)) != length(edge_reac)) { 276 | ## strip rn:: 277 | edge_reac <- edge_reac |> gsub("rn:", "", x=_) 278 | for (ed in edge_reac) { 279 | if (ed %in% names(rls)) { 280 | rls[ed] <- TRUE 281 | } 282 | } 283 | for (r in names(rls)) { 284 | reac <- gsub(r, rls[r], reac) 285 | } 286 | reac <- gsub(",", "|", gsub("\\+", "&", reac)) 287 | ## Eval boolean or length interpretation 288 | if (eval(parse(text=reac))) { 289 | cand_node_ids <- edge_df[xn,]$orig.id 290 | cand_node_ids <- cand_node_ids[!is.na(cand_node_ids)] |> 291 | unique() 292 | if (length(cand_node_ids) >= 1) { 293 | for (ni in cand_node_ids) { 294 | edges_ind <- node_df[node_df$orig.id %in% ni,] |> 295 | row.names() 296 | tmp_edge_df <- edge_df[edge_df$from %in% edges_ind,] 297 | tmp_edge_df_2 <- edge_df[edge_df$to %in% edges_ind,] 298 | 299 | node1 <- tmp_edge_df_2$from 300 | node2 <- tmp_edge_df$to 301 | 302 | subst <- node_df[tmp_edge_df_2$from,]$name |> 303 | strsplit(" ") |> unlist() |> unique() 304 | prod <- node_df[tmp_edge_df$to,]$name |> 305 | strsplit(" ") |> unlist() |> unique() 306 | 307 | ## reversible 308 | if ((length(intersect(subst, 309 | left)) == length(left) & 310 | length(intersect(prod, 311 | right)) == length(right)) | 312 | (length(intersect(subst, 313 | right)) == length(right) & 314 | length(intersect(prod, 315 | left)) == length(left))) { 316 | return(list("ind"=xn, 317 | "nind"=c(node1, node2))) 318 | } 319 | } 320 | } 321 | } else {} 322 | } else {} ## if edge is reaction 323 | }) ## each edge 324 | list(lapply(ind, function(x) x[["ind"]]) |> unlist(), 325 | lapply(ind, function(x) x[["nind"]]) |> unlist()) 326 | }) 327 | 328 | all_inds <- lapply(results, function(x) x[[1]]) |> unlist() 329 | nind <- lapply(results, function(x) x[[2]]) |> unlist() 330 | 331 | einds[all_inds] <- TRUE 332 | ninds[unique(as.numeric(nind))] <- TRUE 333 | 334 | graph |> 335 | activate("edges") |> 336 | mutate(!!kmo@ID:=einds) |> 337 | activate("nodes") |> 338 | mutate(!!kmo@ID:=ninds) 339 | } -------------------------------------------------------------------------------- /R/network_functions.R: -------------------------------------------------------------------------------- 1 | setOldClass("tbl_graph") 2 | setClass("kegg_network", 3 | slots=list( 4 | ID="character", 5 | name="character", 6 | definition="character", 7 | expanded="character", 8 | expanded_graph="tbl_graph", 9 | definition_graph="tbl_graph", 10 | network_class="character", 11 | gene="character", 12 | metabolite="character" 13 | ) 14 | ) 15 | 16 | setMethod("show", 17 | signature(object="kegg_network"), 18 | function(object) { 19 | cat(object@ID,"\n") 20 | cat(object@name,"\n") 21 | } 22 | ) 23 | 24 | #' get_network_attribute 25 | #' 26 | #' get slot from `kegg_network` class 27 | #' 28 | #' @param x kegg_network class object 29 | #' @param attribute pass to get_network_attribute 30 | #' @return attribute of kegg_network 31 | #' @export 32 | setGeneric("get_network_attribute", 33 | function(x, attribute) standardGeneric("get_network_attribute")) 34 | 35 | #' get_network_attribute 36 | #' 37 | #' get the kegg_network class attribute 38 | #' 39 | #' @param x kegg_network class object 40 | #' @param attribute slot name 41 | #' @return attribute of kegg_module 42 | setMethod("get_network_attribute", "kegg_network", 43 | function(x, attribute) attr(x, attribute)) 44 | 45 | #' KEGG network parsing function 46 | #' 47 | #' parsing the network elements starting with N 48 | #' 49 | #' @param nid KEGG NETWORK ID 50 | #' @param use_cache use cache 51 | #' @param directory directory to save raw files 52 | #' @return list of network definition 53 | #' @examples network("N00002") 54 | #' @export 55 | network <- function(nid, use_cache=FALSE, directory=NULL) { 56 | if (!startsWith(nid, "N")) { 57 | stop("Please provide a string that starts with N.") 58 | } 59 | kne <- new("kegg_network") 60 | kne@ID <- nid 61 | if (!is.null(directory)) { 62 | dest <- paste0(directory,"/",nid) 63 | } else { 64 | dest <- nid 65 | } 66 | if (!file.exists(dest)) { 67 | if (use_cache) { 68 | bfc <- BiocFileCache() 69 | dest <- bfcrpath(bfc, 70 | paste0("https://rest.kegg.jp/get/",nid)) 71 | } else { 72 | download.file(paste0("https://rest.kegg.jp/get/",nid), 73 | destfile=dest) 74 | } 75 | } 76 | con <- file(dest, "r") 77 | 78 | while ( TRUE ) { 79 | line <- readLines(con, n=1) 80 | if ( length(line) == 0 ) { 81 | break 82 | } 83 | if (grepl("NAME", line)) { 84 | name <- unlist(strsplit(line, " "))[2] 85 | kne@name <- name 86 | } 87 | if (grepl("DEFINITION", line)) { 88 | definition <- unlist(strsplit(line, " "))[2] 89 | kne@definition <- definition 90 | } 91 | if (grepl("EXPANDED", line)) { 92 | expanded <- unlist(strsplit(line, " "))[3] 93 | kne@expanded <- expanded 94 | } 95 | if (grepl("CLASS", line)) { 96 | network_class <- unlist(strsplit(line, " "))[2] 97 | kne@network_class <- network_class 98 | } 99 | } 100 | close(con) 101 | kne@expanded_graph <- convert_expanded_to_graph(kne) 102 | kne@definition_graph <- convert_definition_to_graph(kne) 103 | kne 104 | } 105 | 106 | #' @noRd 107 | convert_expanded_to_graph <- function(kne) { 108 | sp <- kne@expanded |> strsplit(" ") |> unlist() 109 | edges <- lapply(seq(1,length(sp), 2), function(i) { 110 | if (i!=length(sp)) { 111 | left <- sp[i] 112 | edge <- sp[i+1] 113 | right <- sp[i+2] 114 | return(c(left, right, edge)) 115 | } else {} 116 | }) 117 | edges <- do.call(rbind, edges) |> data.frame() |> 118 | `colnames<-`(c("from","to","type")) 119 | return(as_tbl_graph(edges)) 120 | } 121 | 122 | #' @noRd 123 | convert_definition_to_graph <- function(kne) { 124 | sp <- kne@definition |> strsplit(" ") |> unlist() 125 | edges <- lapply(seq(1,length(sp), 2), function(i) { 126 | if (i!=length(sp)) { 127 | left <- sp[i] 128 | edge <- sp[i+1] 129 | right <- sp[i+2] 130 | return(c(left, right, edge)) 131 | } else {} 132 | }) 133 | edges <- do.call(rbind, edges) |> data.frame() |> 134 | `colnames<-`(c("from","to","type")) 135 | return(as_tbl_graph(edges)) 136 | } 137 | 138 | 139 | 140 | #' network_graph 141 | #' 142 | #' obtain tbl_graph of KEGG network 143 | #' 144 | #' @param kne network object 145 | #' @param type definition or expanded 146 | #' @return tbl_graph 147 | #' @examples 148 | #' ne <- create_test_network() 149 | #' neg <- network_graph(ne) 150 | #' @export 151 | #' 152 | network_graph <- function (kne, type="definition") { 153 | if (type=="definition") { 154 | raw_nodes <- kne@definition_graph |> activate("nodes") |> data.frame() 155 | raw_edges <- kne@definition_graph |> activate("edges") |> data.frame() 156 | } else { 157 | raw_nodes <- kne@expanded_graph |> activate("nodes") |> data.frame() 158 | raw_edges <- kne@expanded_graph |> activate("edges") |> data.frame() 159 | } 160 | 161 | res <- lapply(seq_along(raw_nodes$name), function(nn) { 162 | bln <- paste0("manual_BLOCK",nn,"_",kne@ID) 163 | ## In NETWORK definition, "-" is included in gene symbol 164 | ## Also, names like `Ca2+` is present, manually curate them 165 | input_string <- gsub("Ca2\\+","Ca",raw_nodes$name[nn]) 166 | gra <- module_graph(input_string, skip_minus=TRUE) 167 | if (is.character(gra)) { 168 | # blocks <- rbind(blocks, c(gra, bln)) 169 | } else { 170 | es <- as_data_frame(gra) 171 | es[,1] <- ifelse(startsWith(es[,1],"manual_CS"), 172 | paste0(es[,1],"_",nn,"_",kne@ID) ,es[,1]) 173 | es[,2] <- ifelse(startsWith(es[,2],"manual_CS"), 174 | paste0(es[,2],"_",nn,"_",kne@ID) ,es[,2]) 175 | es[,1] <- ifelse(startsWith(es[,1],"manual_G"), 176 | paste0(es[,1],"_",nn,"_",kne@ID) ,es[,1]) 177 | es[,2] <- ifelse(startsWith(es[,2],"manual_G"), 178 | paste0(es[,2],"_",nn,"_",kne@ID) ,es[,2]) 179 | 180 | vs <- data.frame(V(gra)$name, bln) 181 | vs[,1] <- ifelse(startsWith(vs[,1],"manual_CS"), 182 | paste0(vs[,1],"_",nn,"_",kne@ID) ,vs[,1]) 183 | vs[,1] <- ifelse(startsWith(vs[,1],"manual_G"), 184 | paste0(vs[,1],"_",nn,"_",kne@ID) ,vs[,1]) 185 | vs <- do.call(rbind, lapply(vs[,1], function(j) { 186 | c(j,bln,"in_block") 187 | })) |> data.frame() |> `colnames<-`(c("from","to","type")) 188 | list(rbind(es, vs), nn) 189 | } 190 | }) 191 | edges <- do.call(rbind, lapply(res, function(x) x[[1]])) 192 | name_change <- lapply(res, function(x) x[[2]]) |> unlist() 193 | nns <- lapply(res, function(x) x[[2]]) |> unlist() 194 | 195 | name_change <- paste0("manual_BLOCK",name_change,"_",kne@ID) 196 | names(name_change) <- as.character(nns) 197 | 198 | new_edges_from <- NULL 199 | new_edges_to <- NULL 200 | 201 | new_edges_from <- lapply(raw_edges$from, function(i) { 202 | if (i %in% names(name_change)) { 203 | as.character(name_change[as.character(i)]) 204 | } else { 205 | raw_nodes$name[i] 206 | } 207 | }) |> unlist() 208 | 209 | new_edges_to <- lapply(raw_edges$to, function(i) { 210 | if (i %in% names(name_change)) { 211 | as.character(name_change[as.character(i)]) 212 | } else { 213 | raw_nodes$name[i] 214 | } 215 | }) |> unlist() 216 | 217 | raw_edges$from <- new_edges_from 218 | raw_edges$to <- new_edges_to 219 | raw_edges$subtype <- "reference" 220 | if (!is.null(edges)) { 221 | edges$subtype <- "manual" 222 | } 223 | all_edges <- rbind(raw_edges |> 224 | `colnames<-`(c("from","to","type","subtype")), edges) 225 | g <- as_tbl_graph(all_edges, directed=TRUE) 226 | g <- g |> activate("nodes") |> 227 | mutate(network_name=kne@name, network_ID=kne@ID) 228 | g 229 | } 230 | 231 | #' create_test_network 232 | #' @return test network 233 | #' @export 234 | #' @examples create_test_network() 235 | create_test_network <- function() { 236 | ne <- new("kegg_network") 237 | ne@ID <- "test" 238 | ne@name <- "test network" 239 | ne@definition <- "DDX41 -> IRF3" 240 | ne@definition_graph <- convert_definition_to_graph(ne) 241 | ne 242 | } 243 | -------------------------------------------------------------------------------- /R/overlay_functions.R: -------------------------------------------------------------------------------- 1 | #' overlay_raw_map 2 | #' 3 | #' Overlay the raw KEGG pathway image on ggraph 4 | #' 5 | #' @param pid pathway ID 6 | #' @param directory directory to store images if not use cache 7 | #' @param transparent_colors make these colors transparent to overlay 8 | #' Typical choice of colors would be: 9 | #' "#CCCCCC", "#FFFFFF","#BFBFFF","#BFFFBF", "#7F7F7F", "#808080", 10 | #' "#ADADAD","#838383","#B3B3B3" 11 | #' @param clip clip the both end of x- and y-axis by one dot 12 | #' @param adjust adjust the x- and y-axis location by 0.5 in data coordinates 13 | #' @param adjust_manual_x adjust the position manually for x-axis 14 | #' Override `adjust` 15 | #' @param adjust_manual_y adjust the position manually for y-axis 16 | #' Override `adjust` 17 | #' @param use_cache whether to use BiocFileCache() 18 | #' @param interpolate parameter in annotation_raster() 19 | #' @param high_res Use high resolution (2x) image for the overlay 20 | #' @param fix_coordinates fix the coordinate (coord_fixed) 21 | #' @import magick 22 | #' @return ggplot2 object 23 | #' @export 24 | #' @examples 25 | #' ## Need `pathway_id` column in graph 26 | #' ## if the function is to automatically infer 27 | #' graph <- create_test_pathway() |> mutate(pathway_id="hsa04110") 28 | #' ggraph(graph) + overlay_raw_map() 29 | #' 30 | overlay_raw_map <- function(pid=NULL, directory=NULL, 31 | transparent_colors=c("#FFFFFF", 32 | "#BFBFFF","#BFFFBF"), 33 | adjust=FALSE, 34 | adjust_manual_x=NULL, 35 | adjust_manual_y=NULL, 36 | clip=FALSE, 37 | use_cache=TRUE, 38 | interpolate=TRUE, 39 | high_res=FALSE, 40 | fix_coordinates=TRUE) { 41 | structure(list(pid=pid, 42 | transparent_colors=transparent_colors, 43 | adjust=adjust, 44 | clip=clip, 45 | adjust_manual_x=adjust_manual_x, 46 | adjust_manual_y=adjust_manual_y, 47 | directory=directory, 48 | use_cache=use_cache, 49 | interpolate=interpolate, 50 | high_res=high_res, 51 | fix_coordinates=fix_coordinates), 52 | class="overlay_raw_map") 53 | } 54 | 55 | #' ggplot_add.overlay_raw_map 56 | #' @param object An object to add to the plot 57 | #' @param plot The ggplot object to add object to 58 | #' @param object_name The name of the object to add 59 | #' @export ggplot_add.overlay_raw_map 60 | #' @return ggplot2 object 61 | #' @importFrom grDevices as.raster 62 | #' @export 63 | #' @examples 64 | #' ## Need `pathway_id` column in graph 65 | #' ## if the function is to automatically infer 66 | #' graph <- create_test_pathway() |> mutate(pathway_id="hsa04110") 67 | #' ggraph(graph) + overlay_raw_map() 68 | #' 69 | ggplot_add.overlay_raw_map <- function(object, plot, object_name) { 70 | if (is.null(object$pid)) { 71 | infer <- plot$data$pathway_id |> unique() 72 | object$pid <- infer[!is.na(infer)] 73 | if (object$high_res) { 74 | ## Convert to reference ID 75 | cur_id <- object$pid 76 | object$pid <- paste0("map", 77 | regmatches(cur_id, gregexpr("[[:digit:]]+", cur_id)) %>% unlist()) 78 | } 79 | } 80 | if (!grepl("[[:digit:]]", object$pid)) { 81 | warning("Looks like not KEGG ID for pathway") 82 | return(1) 83 | } 84 | ## Return the image URL, download and cache 85 | ## From 1.1.10 86 | url <- paste0("https://rest.kegg.jp/get/",object$pid,"/image") 87 | if (object$high_res) { 88 | if (!startsWith(object$pid, "map")) { 89 | stop("High resolution image can be obtained for the reference pathway.") 90 | } 91 | url <- paste0(url, "2x") 92 | } 93 | if (object$use_cache) { 94 | bfc <- BiocFileCache() 95 | path <- bfcrpath(bfc, url) 96 | } else { 97 | path <- paste0(object$pid, ".png") 98 | if (!is.null(object$directory)) { 99 | path <- paste0(object$directory,"/",path) 100 | if (!file.exists(path)) { 101 | stop("No PNG file found in the directory.") 102 | } 103 | } else { 104 | download.file(url=url, destfile=path, mode='wb') 105 | } 106 | } 107 | 108 | ## Load, transparent and rasterize 109 | magick_image <- image_read(path) 110 | img_info <- image_info(magick_image) 111 | w <- img_info$width 112 | h <- img_info$height 113 | 114 | for (col in object$transparent_colors) { 115 | magick_image <- magick_image |> 116 | image_transparent(col) 117 | } 118 | 119 | ras <- as.raster(magick_image) 120 | 121 | 122 | xmin <- 0 123 | xmax <- w-1 124 | ymin <- -1*h 125 | ymax <- 0 126 | 127 | if (object$clip) { 128 | ras <- ras[seq_len(nrow(ras)-1), 129 | seq_len(ncol(ras)-1)] 130 | } 131 | if (!is.null(object$adjust_manual_x)) { 132 | object$adjust <- FALSE 133 | xmin <- xmin + object$adjust_manual_x 134 | xmax <- xmax + object$adjust_manual_x 135 | } 136 | if (!is.null(object$adjust_manual_y)) { 137 | object$adjust <- FALSE 138 | ymin <- ymin + object$adjust_manual_y 139 | ymax <- ymax + object$adjust_manual_y 140 | } 141 | if (object$adjust) { 142 | xmin <- xmin - 0.5 143 | xmax <- xmax - 0.5 144 | ymin <- ymin - 0.5 145 | ymax <- ymax - 0.5 146 | } 147 | p <- plot + 148 | annotation_raster(ras, xmin=xmin, ymin=ymin, 149 | xmax=xmax, ymax=ymax, interpolate=object$interpolate)+ 150 | scale_x_continuous(expand=c(0,0), limits=c(0,w-1)) + 151 | scale_y_continuous(expand=c(0,0), limits=c(-1*h+1,0)) 152 | attr(p, "original_width") <- w 153 | attr(p, "original_height") <- h 154 | if (object$fix_coordinates) { 155 | p <- p + coord_fixed() 156 | } 157 | return(p) 158 | } 159 | 160 | 161 | #' ggkeggsave 162 | #' 163 | #' save the image respecting the original width and height of the image. 164 | #' Only applicable for the ggplot object including `overlay_raw_map` layers. 165 | #' 166 | #' @param filename file name of the image 167 | #' @param plot plot to be saved 168 | #' @param dpi dpi, passed to ggsave 169 | #' @param wscale width scaling factor for pixel to inches 170 | #' @param hscale height scaling factor fo pixel to inches 171 | #' @return save the image 172 | #' @export 173 | #' 174 | ggkeggsave <- function(filename, plot, dpi=300, wscale=90, hscale=90) { 175 | ggsave(filename, plot, dpi=dpi, width=attr(plot, "original_width")/wscale, 176 | height=attr(plot, "original_height")/hscale, units="in") 177 | } 178 | 179 | 180 | #' output_overlay_image 181 | #' 182 | #' The function first exports the image, combine it with the original image. 183 | #' Note that if the legend is outside the pathway image, the result will not 184 | #' show it correctly. Place the legend inside the panel by adding the theme 185 | #' such as theme(legend.position=c(0.5, 0.5)). 186 | #' 187 | #' If the legend must be placed outside the image, the users can set 188 | #' with_legend_image to TRUE. This will create another legend only image 189 | #' and concatenate it with the pathway image. legend_space option can be 190 | #' specified to control the spacing for the legend. If need to append horizontal 191 | #' legend, enable legend_horiz option. 192 | #' 193 | #' By default, unlink option is enabled which means the function will delete 194 | #' the intermediate files. 195 | #' 196 | #' 197 | #' @param gg ggraph object 198 | #' @param with_legend if legend (group-box) is in gtable, output them 199 | #' @param use_cache use BiocFileCache for caching the image 200 | #' @param high_res use 2x resolution image 201 | #' @param res resolution parameter passed to saving the ggplot2 image 202 | #' @param out output file name 203 | #' @param directory specify if you have already downloaded the image 204 | #' @param transparent_colors transparent colors 205 | #' @param unlink unlink the intermediate image 206 | #' @param with_legend_image append legend image instead of using gtable 207 | #' @param legend_horiz append legend to the bottom of the image 208 | #' @param legend_space legend spacing specification (in pixel) 209 | #' @export 210 | #' @importFrom grDevices dev.off png 211 | #' @import gtable 212 | #' @return output the image and return the path 213 | #' @examples 214 | #' \dontrun{ 215 | #' ouput_overlay_image(ggraph(pathway("hsa04110"))) 216 | #' } 217 | #' 218 | #' 219 | output_overlay_image <- function(gg, with_legend=TRUE, 220 | use_cache=TRUE, high_res=FALSE, res=72, out=NULL, directory=NULL, 221 | transparent_colors=c("#FFFFFF", "#BFBFFF","#BFFFBF","#7F7F7F", "#808080"), 222 | unlink=TRUE, with_legend_image=FALSE, legend_horiz=FALSE, legend_space=100 223 | ) { 224 | pid <- gg$data$pathway_id %>% unique() 225 | if (length(pid)>1) {stop("Only one pathway is supported.")} 226 | url <- paste0("https://rest.kegg.jp/get/",pid,"/image") 227 | if (high_res) { 228 | ## Convert to reference ID 229 | cur_id <- pid 230 | pid <- paste0("map", regmatches(cur_id, gregexpr("[[:digit:]]+", cur_id)) %>% unlist()) 231 | 232 | ## sanity check 233 | if (!startsWith(pid, "map")) { 234 | stop("High resolution image can be obtained for the reference pathway.") 235 | } 236 | url <- paste0("https://rest.kegg.jp/get/",pid,"/image") 237 | url <- paste0(url, "2x") 238 | } 239 | if (use_cache) { 240 | bfc <- BiocFileCache() 241 | path <- bfcrpath(bfc, url) 242 | } else { 243 | path <- paste0(pid, ".png") 244 | if (!is.null(directory)) { 245 | path <- paste0(directory,"/",path) 246 | } 247 | download.file(url=url, destfile=path, mode='wb') 248 | } 249 | magick_image <- image_read(path) 250 | info <- image_info(magick_image) 251 | for (col in transparent_colors) { 252 | magick_image <- magick_image %>% 253 | image_transparent(col) 254 | } 255 | 256 | ## Modify original gg to align with the image 257 | gg <- gg + scale_x_continuous(expand=c(0,0), limits=c(0,info$width-1)) + 258 | scale_y_continuous(expand=c(0,0), limits=c(-1*info$height+1, 0)) 259 | 260 | ## Obtain grob and get panel 261 | ggGrob <- ggplotGrob(gg) 262 | legendGrob <- NULL 263 | panelGrob <- gtable::gtable_filter(ggGrob, "panel") 264 | if (length(gtable::gtable_filter(ggGrob, "guide-box"))!=0) { 265 | legendGrob <- gtable::gtable_filter(ggGrob, "guide-box") 266 | } 267 | 268 | ## Export grob 269 | timestamp <- as.numeric(Sys.time()) 270 | ggname <- paste0(pid, "_", timestamp, ".png") 271 | png(ggname, width=info$width, height=info$height, res=res, units="px") 272 | grid::grid.draw(panelGrob) 273 | if (!with_legend_image & with_legend & !is.null(legendGrob)) { 274 | grid::grid.draw(legendGrob) 275 | } 276 | dev.off() 277 | if (with_legend_image & !is.null(legendGrob)) { 278 | ggLegendName <- paste0(pid, "_legend_", timestamp, ".png") 279 | if (legend_horiz) { 280 | lw <- info$width 281 | lh <- legend_space 282 | } else { 283 | lw <- legend_space 284 | lh <- info$height 285 | } 286 | png(ggLegendName, width=lw, height=lh, res=res, units="px") 287 | grid::grid.draw(legendGrob) 288 | dev.off() 289 | from_gg_legend <- image_read(ggLegendName) 290 | } 291 | 292 | from_gg <- image_read(ggname) 293 | 294 | if (unlink) { 295 | unlink(ggname) 296 | if (with_legend_image & !is.null(legendGrob)) { 297 | unlink(ggLegendName) 298 | } 299 | } 300 | 301 | flat <- image_flatten(c(from_gg, magick_image)) 302 | if (with_legend_image & !is.null(legendGrob)) { 303 | if (legend_horiz) { 304 | flat <- image_append(c(flat, from_gg_legend), stack=TRUE) 305 | } else { 306 | flat <- image_append(c(flat, from_gg_legend)) 307 | } 308 | } 309 | if (is.null(out)) { 310 | out <- paste0(pid, "_ggkegg.png") 311 | } 312 | image_write(flat, out) 313 | return(out) 314 | } 315 | 316 | 317 | 318 | #' addTitle 319 | #' 320 | #' Add the title to the image produced by output_overlay_image 321 | #' using magick. 322 | #' 323 | #' @param out the image 324 | #' @param title the title 325 | #' @param size the size 326 | #' @param height title height 327 | #' @param color bg color 328 | #' @param titleColor title color 329 | #' @param gravity positioning of the title in the blank image 330 | #' @export 331 | #' @return output the image 332 | add_title <- function(out, title=NULL, size=20, height=30, color="white", 333 | titleColor="black", gravity="west") { 334 | 335 | img <- image_read(out) 336 | info <- image_info(img) 337 | w <- info$width 338 | h <- info$height 339 | blank <- image_blank(width=w, height=height, color=color) 340 | imganno <- image_annotate(blank, title, size = size, 341 | color=titleColor, gravity=gravity) 342 | res <- image_append(c(imganno, img), stack=TRUE) 343 | image_write(res, out) 344 | return(res) 345 | } -------------------------------------------------------------------------------- /R/pathway_functions.R: -------------------------------------------------------------------------------- 1 | #' pathway 2 | #' 3 | #' KEGG pathway parsing function 4 | #' 5 | #' @param pid pathway id 6 | #' @param directory directory to download KGML 7 | #' @param use_cache whether to use BiocFileCache 8 | #' @param add_pathway_id add pathway id to graph, default to TRUE 9 | #' needed for the downstream analysis 10 | #' @param group_rect_nudge nudge the position of group node 11 | #' default to add slight increase to show the group node 12 | #' @param node_rect_nudge nudge the position of all node 13 | #' @param invert_y invert the y position to match with R graphics 14 | #' @param return_image return the image URL 15 | #' @param return_tbl_graph return tbl_graph object, if FALSE, return igraph 16 | #' @return tbl_graph by default 17 | #' @importFrom igraph graph_from_data_frame 18 | #' @import igraph 19 | #' @importFrom tidygraph .G 20 | #' @importFrom XML xmlParse xmlApply 21 | #' @importFrom tibble as_tibble 22 | #' @importFrom utils download.file head tail 23 | #' @examples pathway("hsa04110") 24 | #' @export 25 | pathway <- function(pid, 26 | directory=NULL, 27 | use_cache=FALSE, 28 | group_rect_nudge=2, 29 | node_rect_nudge=0, 30 | invert_y=TRUE, 31 | add_pathway_id=TRUE, 32 | return_tbl_graph=TRUE, 33 | return_image=FALSE) { 34 | 35 | ## Specification of KGML format is available at: 36 | ## https://www.genome.jp/kegg/xml/docs/ 37 | 38 | file_name <- paste0(pid,".xml") 39 | if (!is.null(directory)) { 40 | file_name <- paste0(directory,"/",file_name) 41 | } 42 | if (!file.exists(file_name)) { 43 | if (use_cache) { 44 | bfc <- BiocFileCache() 45 | file_name <- bfcrpath(bfc, 46 | paste0("https://rest.kegg.jp/get/",pid,"/kgml")) 47 | } else { 48 | download.file(url=paste0("https://rest.kegg.jp/get/",pid,"/kgml"), 49 | destfile=file_name) 50 | } 51 | } 52 | 53 | xml <- xmlParse(file_name) 54 | node_sets <- getNodeSet(xml, "//entry") 55 | 56 | ## Preallocate 57 | all_nodes <- vector(mode="list", length=length(node_sets)) 58 | grs <- vector(mode="list", length=length(node_sets)) 59 | rev_grs <- vector(mode="list", length=length(node_sets)) 60 | 61 | node_names <- c("id","name","type","reaction", 62 | "graphics_name", 63 | "x","y","width","height","fgcolor","bgcolor", 64 | "graphics_type","coords") 65 | 66 | pwy <- getNodeSet(xml, "//pathway")[[1]] 67 | 68 | pwy_name <- xmlAttrs(pwy)["name"] 69 | pwy_org <- xmlAttrs(pwy)["org"] 70 | pwy_number <- xmlAttrs(pwy)["number"] 71 | pwy_title <- xmlAttrs(pwy)["title"] 72 | pwy_image <- xmlAttrs(pwy)["image"] 73 | pwy_link <- xmlAttrs(pwy)["link"] 74 | 75 | if (return_image) return(pwy_image) 76 | 77 | ni <- 1 78 | for (node in node_sets) { 79 | id <- xmlAttrs(node)["id"] 80 | name <- xmlAttrs(node)["name"] 81 | type <- xmlAttrs(node)["type"] 82 | reac <- xmlAttrs(node)["reaction"] 83 | 84 | gls <- getNodeSet(node, "graphics") 85 | 86 | ## Preallocate 87 | mult_coords <- vector(mode="list", 88 | length=length(xmlApply(gls, function(x) xmlAttrs(x)["coords"]))) 89 | for (gl in gls) { 90 | glname <- xmlAttrs(gl)["name"] 91 | gltype <- xmlAttrs(gl)["type"] 92 | 93 | ## If multiple graphics, take the last 94 | ## parameters and append only the multiple coordinates 95 | ## Otherwise graph will have duplicate 'original' ID 96 | 97 | glcoords <- xmlAttrs(gl)["coords"] 98 | mult_coords <- c(mult_coords, glcoords) 99 | 100 | x <- as.numeric(xmlAttrs(gl)["x"]) 101 | if (invert_y) { 102 | y <- -1*as.numeric(xmlAttrs(gl)["y"]) 103 | } else { 104 | y <- as.numeric(xmlAttrs(gl)["y"]) 105 | } 106 | 107 | w <- as.numeric(xmlAttrs(gl)["width"]) 108 | h <- as.numeric(xmlAttrs(gl)["height"]) 109 | fg <- xmlAttrs(gl)["fgcolor"] 110 | bg <- xmlAttrs(gl)["bgcolor"] 111 | 112 | if (type=="group") { 113 | for (comp in xmlElementsByTagName(node,"component")) { 114 | grs[[as.character(id)]] <- 115 | c(grs[[as.character(id)]], 116 | as.character(xmlAttrs(comp)["id"])) 117 | rev_grs[[as.character(xmlAttrs(comp)["id"])]] <- 118 | c(rev_grs[[as.character(xmlAttrs(comp)["id"])]], 119 | as.character(id)) 120 | } 121 | } 122 | } 123 | all_nodes[[ni]] <- c(id, name, type, reac, 124 | glname, x, y, w, h, fg, bg, gltype, 125 | paste0(mult_coords |> unlist(), collapse="|")) |> 126 | setNames(node_names) 127 | ni <- ni + 1 128 | } 129 | 130 | all_nodes[vapply(all_nodes, is.null, TRUE)] <- NULL 131 | grs[vapply(grs, is.null, TRUE)] <- NULL 132 | rev_grs[vapply(rev_grs, is.null, TRUE)] <- NULL 133 | 134 | kegg_nodes <- dplyr::bind_rows(all_nodes) |> data.frame() |> 135 | `colnames<-`(node_names) 136 | 137 | kegg_nodes$x <- as.numeric(kegg_nodes$x) 138 | kegg_nodes$y <- as.numeric(kegg_nodes$y) 139 | kegg_nodes$width <- as.numeric(kegg_nodes$width) 140 | kegg_nodes$height <- as.numeric(kegg_nodes$height) 141 | 142 | kegg_nodes$xmin <- kegg_nodes$x-kegg_nodes$width/2-node_rect_nudge 143 | kegg_nodes$xmax <- kegg_nodes$x+kegg_nodes$width/2+node_rect_nudge 144 | kegg_nodes$ymin <- kegg_nodes$y-kegg_nodes$height/2-node_rect_nudge 145 | kegg_nodes$ymax <- kegg_nodes$y+kegg_nodes$height/2+node_rect_nudge 146 | 147 | kegg_nodes[kegg_nodes$type=="group",]$xmin <- 148 | kegg_nodes[kegg_nodes$type=="group",]$xmin-group_rect_nudge 149 | kegg_nodes[kegg_nodes$type=="group",]$ymin <- 150 | kegg_nodes[kegg_nodes$type=="group",]$ymin-group_rect_nudge 151 | kegg_nodes[kegg_nodes$type=="group",]$xmax <- 152 | kegg_nodes[kegg_nodes$type=="group",]$xmax+group_rect_nudge 153 | kegg_nodes[kegg_nodes$type=="group",]$ymax <- 154 | kegg_nodes[kegg_nodes$type=="group",]$ymax+group_rect_nudge 155 | 156 | kegg_nodes$orig.id <- kegg_nodes$id ## Store ID as orig.id 157 | 158 | rel_sets <- getNodeSet(xml, "//relation") 159 | ## Preallocate 160 | all_rels <- vector(mode="list", length=length(rel_sets)) 161 | ei <- 1 162 | rel_names <- c("entry1","entry2","type", 163 | "subtype_name","subtype_value") 164 | for (rel in rel_sets) { 165 | entry1 <- xmlAttrs(rel)["entry1"] 166 | entry2 <- xmlAttrs(rel)["entry2"] 167 | rel_type <- xmlAttrs(rel)["type"] 168 | # rel_subtype <- xmlAttrs(rel[["subtype"]])["name"] 169 | rel_subtypes <- xmlElementsByTagName(rel,"subtype") 170 | if (length(rel_subtypes)!=0) { 171 | for (rs in rel_subtypes) { 172 | all_rels[[ei]] <- c(entry1, entry2, rel_type, 173 | xmlAttrs(rs)["name"], xmlAttrs(rs)["value"]) |> 174 | setNames(rel_names) 175 | ei <- ei + 1 176 | } 177 | } else { 178 | all_rels[[ei]] <- c(entry1, entry2, rel_type, NA, NA) |> 179 | setNames(rel_names) 180 | ei <- ei + 1 181 | } 182 | } 183 | 184 | if (length(all_rels) != 0) { 185 | kegg_edges <- dplyr::bind_rows(all_rels) |> data.frame() |> 186 | `colnames<-`(c("entry1","entry2","type", 187 | "subtype_name","subtype_value")) 188 | } else { 189 | kegg_edges <- NULL 190 | } 191 | 192 | gr_rels <- lapply(names(grs), function(gr_name) { 193 | tmp_rel <- lapply(grs[[gr_name]], function(comp_name) { 194 | ## Pad other values by `in_group` 195 | return(c(gr_name, comp_name, "in_group", NA, NA)) 196 | }) 197 | do.call(rbind, tmp_rel) 198 | }) 199 | gr_rels <- do.call(rbind, gr_rels) 200 | 201 | 202 | if (length(getNodeSet(xml, "//reaction"))!=0) { 203 | kegg_reac <- get_reaction(xml) 204 | if (!is.null(kegg_edges)) {kegg_edges$reaction <- NA 205 | kegg_edges$reaction_id <- NA} 206 | kegg_edges <- rbind(kegg_edges, kegg_reac) 207 | } 208 | 209 | ## Append grouping 210 | if (!is.null(kegg_edges)) { 211 | if (!is.null(gr_rels)) { 212 | gr_rels <- gr_rels |> 213 | data.frame() |> 214 | `colnames<-`(c("entry1","entry2","type", 215 | "subtype_name","subtype_value")) 216 | if ("reaction" %in% colnames(kegg_edges)) { 217 | gr_rels$reaction <- NA 218 | gr_rels$reaction_id <- NA 219 | } 220 | kegg_edges <- rbind(kegg_edges, gr_rels) 221 | } 222 | } 223 | if (!is.null(kegg_edges)) { 224 | g <- graph_from_data_frame(kegg_edges, vertices=kegg_nodes) 225 | } else { 226 | g <- tbl_graph(nodes=kegg_nodes) 227 | } 228 | 229 | 230 | if (add_pathway_id) { 231 | V(g)$pathway_id <- pid 232 | E(g)$pathway_id <- pid 233 | } 234 | if (return_tbl_graph) { 235 | return(as_tbl_graph(g)) 236 | } else { 237 | return(g) 238 | } 239 | } 240 | parse_kgml <- pathway 241 | 242 | #' process_line 243 | #' 244 | #' process the KGML containing graphics type of `line`, like 245 | #' global maps e.g. ko01100. Recursively add nodes and edges 246 | #' connecting them based on `coords` properties in KGML. 247 | #' 248 | #' We cannot show directed arrows, as coords are not ordered to show direction. 249 | #' 250 | #' @param g graph 251 | #' @param invert_y whether to invert the position, default to TRUE 252 | #' should match with `pathway` function 253 | #' @param verbose show progress 254 | #' @importFrom tidygraph bind_nodes bind_edges 255 | #' @export 256 | #' @return tbl_graph 257 | #' @examples 258 | #' ## For those containing nodes with the graphic type of `line`, 259 | #' ## parse the coords attributes to edges. 260 | #' gm_test <- create_test_pathway(line=TRUE) 261 | #' test <- process_line(gm_test) 262 | process_line <- function(g, invert_y=TRUE, verbose=FALSE) { 263 | 264 | df <- as_tbl_graph(g) 265 | name_col_node <- c("name","x","y","type","original_name","node.orig.id") 266 | name_col_edge <- c("from","to","type","name", 267 | "bgcolor","fgcolor","reaction","orig.id") 268 | results <- lapply(seq_along(V(g)$name), function(i) { 269 | if (V(g)$graphics_type[i]=="line") { 270 | raw_name <- V(g)$name[i] 271 | bgcol <- V(g)$bgcolor[i] 272 | fgcol <- V(g)$fgcolor[i] 273 | reac <- V(g)$reaction[i] 274 | origid <- V(g)$orig.id[i] 275 | rawco <- V(g)$coords[i] 276 | 277 | if (grepl("\\|",rawco)) { 278 | rawcos <- strsplit(rawco, "\\|") |> unlist() 279 | } else { 280 | rawcos <- rawco 281 | } 282 | 283 | lapply(seq_along(rawcos), function(rc) { 284 | co <- unlist(strsplit(rawcos[rc], ",")) 285 | lapply(seq_len(length(co)), function(h) { 286 | if (is.na(co[h+2])) {return(NULL)} 287 | if (h %% 2 == 0) {return(NULL)} 288 | ## Assign unique identifiers each node 289 | list( 290 | c(paste0(raw_name,"_",i,"_",rc,"_",h), 291 | co[h], co[h+1], "line", raw_name, origid) |> 292 | setNames(name_col_node), 293 | c(paste0(raw_name,"_",i,"_",rc,"_",h+1), 294 | co[h+2], co[h+3], "line", raw_name, origid)|> 295 | setNames(name_col_node), 296 | c(paste0(raw_name,"_",i,"_",rc,"_",h), 297 | paste0(raw_name,"_",i,"_",rc,"_",h+1), 298 | "line", raw_name, bgcol, fgcol, reac, origid) |> 299 | setNames(name_col_edge) 300 | ) 301 | }) 302 | }) 303 | } 304 | }) 305 | 306 | results <- results |> unlist(recursive=FALSE) 307 | results <- results |> unlist(recursive=FALSE) 308 | results[vapply(results, is.null, TRUE)] <- NULL 309 | 310 | cos <- do.call(rbind, lapply(results, function(x) { 311 | rbind(x[[1]],x[[2]]) 312 | })) |> data.frame() |> `colnames<-`(name_col_node) 313 | eds <- do.call(rbind, lapply(results, function(x) { 314 | x[[3]] 315 | })) |> data.frame() |> `colnames<-`(name_col_edge) 316 | 317 | 318 | cos$x <- as.numeric(cos$x); 319 | if (invert_y) { 320 | cos$y <- -1 * as.numeric(cos$y) 321 | } else { 322 | cos$y <- as.numeric(cos$y) 323 | } 324 | 325 | df_add <- df |> bind_nodes(cos) |> bind_edges(eds) 326 | df_add |> activate("nodes") |> 327 | mutate(original_name=vapply(seq_len(length(.data$original_name)), 328 | function(x){ 329 | if(is.na(.data$original_name[x])) { 330 | .data$name[x] 331 | } else { 332 | .data$original_name[x] 333 | } 334 | }, 335 | FUN.VALUE="character")) 336 | } 337 | 338 | #' process_reaction 339 | #' 340 | #' process the kgml of global maps 341 | #' e.g. in ko01100 342 | #' 343 | #' Typically, `process_line` function is used to draw relationships 344 | #' as in the original KGML positions, however, the `coords` properties 345 | #' is not considering the direction of reactions (substrate -> product), 346 | #' thus if it is preferred, `process_reaction` is used to populate 347 | #' new edges corresponding to `substrate -> product` and `product -> substrate` 348 | #' if the reaction is reversible. 349 | #' 350 | #' @param g graph 351 | #' @param single_edge discard one edge when edge type is `reversible` 352 | #' @param keep_no_reaction keep edges not related to reaction 353 | #' @importFrom tidygraph bind_nodes bind_edges 354 | #' @export 355 | #' @return tbl_graph 356 | #' @examples 357 | #' gm_test <- create_test_pathway(line=TRUE) 358 | #' test <- process_reaction(gm_test) 359 | #' 360 | process_reaction <- function(g, single_edge=FALSE, keep_no_reaction=TRUE) { 361 | ## This is perhaps dirty ways to obtain edges. Perhaps directly 362 | ## parsing substrate -> product would be reasonable with 363 | ## assigning "reversible" and "irreversible" 364 | 365 | ## Obtain raw nodes 366 | nds <- g |> activate("nodes") |> data.frame() 367 | 368 | ## Obtain raw edges 369 | eds <- g |> activate("edges") |> data.frame() 370 | no_reacs <- eds[is.na(eds$reaction_id),] 371 | reacs <- eds$reaction_id |> unique() 372 | reacs <- reacs[!is.na(reacs)] 373 | ## Prepare new edges 374 | 375 | new_eds <- lapply(reacs, function(reac_id) { 376 | konm <- nds[nds$orig.id %in% reac_id,]$name |> unique() 377 | konm <- ifelse(is.null(konm), NA, konm) 378 | in_reacs <- eds[eds$reaction_id %in% reac_id, ] 379 | reac_name <- in_reacs$reaction |> unique() 380 | row.names(in_reacs) <- seq_len(nrow(in_reacs)) 381 | reac_type <- in_reacs$type |> unique() 382 | 383 | subst_ind <- which(in_reacs$subtype_name == "substrate") 384 | prod_ind <- which(in_reacs$subtype_name == "product") 385 | 386 | eds <- lapply(subst_ind, function(subst) { 387 | lapply(prod_ind, function(prod) { 388 | fr <- in_reacs[subst, ]$from 389 | to <- in_reacs[prod, ]$to 390 | reac_info <- nds[in_reacs[subst, ]$to, ] 391 | if (reac_type=="irreversible") { 392 | return(c(fr, to, reac_type, reac_name, 393 | konm, reac_info$bgcolor |> unique(), 394 | reac_info$fgcolor |> unique())) 395 | } else if (reac_type=="reversible") { 396 | if (single_edge) { 397 | return(rbind( 398 | c(fr, to, reac_type, 399 | reac_name, konm, 400 | reac_info$bgcolor |> unique(), 401 | reac_info$fgcolor |> unique()) 402 | )) 403 | } else { 404 | return(rbind( 405 | c(fr, to, reac_type, 406 | reac_name, konm, 407 | reac_info$bgcolor |> unique(), 408 | reac_info$fgcolor |> unique()), 409 | c(to, fr, reac_type, 410 | reac_name, konm, 411 | reac_info$bgcolor |> unique(), 412 | reac_info$fgcolor |> unique()) 413 | )) 414 | } 415 | } else { 416 | stop("Unknown reaction type detected") 417 | } 418 | }) 419 | }) 420 | return(eds) 421 | }) 422 | 423 | new_eds <- unlist(new_eds, recursive=FALSE) 424 | new_eds <- do.call(rbind, unlist(new_eds, recursive=FALSE)) |> 425 | data.frame() |> 426 | `colnames<-`(c("from","to","type","reaction", 427 | "name","bgcolor","fgcolor")) 428 | 429 | new_eds <- new_eds[!duplicated(new_eds),] 430 | new_eds$from <- as.integer(new_eds$from) 431 | new_eds$to <- as.integer(new_eds$to) 432 | if (keep_no_reaction) { 433 | if (dim(no_reacs)[1]!=0) {## If the no-reaction row is present 434 | all_columns <- union(colnames(no_reacs), colnames(new_eds)) 435 | for (coln in all_columns) { 436 | if (!coln %in% colnames(new_eds)) { 437 | new_eds[[coln]] <- NA 438 | } 439 | if (!coln %in% colnames(no_reacs)) { 440 | no_reacs[[coln]] <- NA 441 | } 442 | 443 | } 444 | new_eds <- rbind(no_reacs, new_eds) 445 | } 446 | } 447 | new_g <- tbl_graph(nodes=nds, edges=new_eds) 448 | new_g 449 | } 450 | 451 | 452 | #' get_reaction 453 | #' 454 | #' Parse the reaction in KGML. 455 | #' Used internally in pathway(). 456 | #' 457 | #' @noRd 458 | #' @importFrom XML xmlAttrs getNodeSet xmlElementsByTagName 459 | get_reaction <- function(xml) { 460 | rea_sets <- getNodeSet(xml, "//reaction") 461 | all_reas <- lapply(rea_sets, function(rea) { 462 | id <- xmlAttrs(rea)["id"] 463 | name <- xmlAttrs(rea)["name"] 464 | type <- xmlAttrs(rea)["type"] 465 | subs <- xmlElementsByTagName(rea,"substrate") 466 | prod <- xmlElementsByTagName(rea,"product") 467 | ## Looking for `alt` tag 468 | ## Multiple products or substrates are to be expected 469 | if (length(subs)==0) { 470 | ## These do not have edges 471 | return(list(list(c(id, name, type, NA, NA, NA, NA)))) 472 | } else { 473 | lapply(subs, function(ss) { 474 | lapply(prod, function(pp) { 475 | return(c(id, name, type, 476 | xmlAttrs(ss)["id"], xmlAttrs(ss)["name"], 477 | xmlAttrs(pp)["id"], xmlAttrs(pp)["name"])) 478 | }) 479 | }) 480 | } 481 | 482 | }) 483 | all_reas <- unlist(all_reas, recursive=FALSE) 484 | all_reas <- do.call(rbind, unlist(all_reas, recursive=FALSE)) |> 485 | data.frame() |> 486 | `colnames<-`(c("id","reac_name", 487 | "type","substrate_id","substrate_name", 488 | "product_id","product_name")) 489 | 490 | sub_all_reas <- all_reas[is.na(all_reas$substrate_id), ] 491 | all_reas <- all_reas[!is.na(all_reas$substrate_id), ] 492 | 493 | 494 | ## Perhaps this parsing would lead to wrong interpretation 495 | ## But for preserving Compound -> KO edges, this function 496 | ## adds edges of: 497 | ## substrate -> ID (KO) (type: type, reaction: reaction) 498 | ## ID (KO) -> product (type: type, reaction: reaction) 499 | ## Later used in `process_reaction()`. 500 | ## Changed this layout to drop duplicates by distinct() 501 | if (dim(all_reas)[1]==0) { 502 | ## For the reaction specification with only the name, id, and type, 503 | ## these will be omitted from the resulting graph. 504 | ## The nodes are already specified in the node data.frame and 505 | ## Information of "type" will not be in the node table. 506 | ## cbind(sub_all_reas[,"id"], sub_all_reas[,"id"], 507 | ## sub_all_reas[,"type"], NA, NA, NA, sub_all_reas[, "id"]) 508 | return(NULL) 509 | } 510 | rsp_rels <- lapply(seq_len(nrow(all_reas)), function(i) { 511 | lapply(unlist(strsplit(all_reas[i,"id"], " ")), function(j) { 512 | return( 513 | rbind( 514 | c(all_reas[i,"substrate_id"], j, all_reas[i,"type"], 515 | "substrate", NA, all_reas[i, "reac_name"], 516 | all_reas[i, "id"]), 517 | c(j, all_reas[i,"product_id"], all_reas[i,"type"], 518 | "product", NA, all_reas[i, "reac_name"], 519 | all_reas[i, "id"]) 520 | ) 521 | ) 522 | }) 523 | }) 524 | 525 | rsp_rels <- do.call(rbind, unlist(rsp_rels, recursive=FALSE)) |> 526 | data.frame() |> 527 | dplyr::distinct() |> 528 | `colnames<-`(c("entry1","entry2","type", 529 | "subtype_name","subtype_value","reaction","reaction_id")) 530 | rsp_rels 531 | } 532 | 533 | 534 | #' pathway_info 535 | #' 536 | #' obtain the list of pathway information 537 | #' @param pid KEGG Pathway id 538 | #' @param use_cache whether to use cache 539 | #' @param directory directory of file 540 | #' @return list of orthology and module contained in the pathway 541 | #' @examples pathway_info("hsa04110") 542 | #' @export 543 | pathway_info <- function(pid, use_cache=FALSE, directory=NULL) { 544 | if (!is.null(directory)){ 545 | dest <- paste0(directory, "/", pid) 546 | } else { 547 | dest <- pid 548 | } 549 | if (!file.exists(pid)) { 550 | if (use_cache) { 551 | bfc <- BiocFileCache() 552 | dest <- bfcrpath(bfc, paste0("https://rest.kegg.jp/get/",pid)) 553 | } else { 554 | download.file(paste0("https://rest.kegg.jp/get/",pid), 555 | destfile=dest) 556 | } 557 | } 558 | 559 | con <- file(dest, "r") 560 | content_list <- list() 561 | while ( TRUE ) { 562 | line <- readLines(con, n=1) 563 | if ( length(line) == 0 ) { 564 | break 565 | } 566 | if (!startsWith(line, " ")) { 567 | current_id <- strsplit(line, " ") |> 568 | vapply("[", 1, FUN.VALUE="character") 569 | } 570 | if (!current_id %in% c("REFERENCE","///")) { 571 | content <- substr(line, 13, nchar(line)) 572 | content_list[[current_id]] <- c(content_list[[current_id]], content) 573 | } 574 | } 575 | close(con) 576 | content_list$ENTRY <- strsplit(content_list$ENTRY, " ") |> 577 | vapply("[", 1, FUN.VALUE="character") 578 | content_list 579 | } 580 | 581 | 582 | #' create_test_pathway 583 | #' 584 | #' As downloading from KEGG API is not desirable 585 | #' in vignettes or examples, return the `tbl_graph` 586 | #' with two nodes and two edges. 587 | #' @param line return example containing graphics type line 588 | #' @examples create_test_pathway() 589 | #' @export 590 | #' @return tbl_graph 591 | create_test_pathway <- function(line=FALSE) { 592 | 593 | if (line) { 594 | gm_test <- data.frame(name=c("cpd:C99998","cpd:C99999","ko:K00224"), 595 | type=c("compound","compound","ortholog"), 596 | graphics_type=c("circle","circle","line"), 597 | graphics_name=c("C99998","C99999","K00224"), 598 | coords=c(NA, NA, "1,2,3,4,5"), 599 | reaction=c(NA,NA,"rn:R99999"), 600 | orig.id=c(1,2,3), 601 | fgcolor=c("#ff0000","#ff0000","#ff0000"), 602 | bgcolor=c("#ffffff","#ffffff","#ffffff")) 603 | 604 | gm_test_edges <- rbind( 605 | data.frame(from=1,to=3,reaction="rn:R99999", 606 | subtype_name="substrate", 607 | type="irreversible",reaction_id="1"), 608 | data.frame(from=3,to=2,reaction="rn:R99999", 609 | subtype_name="product", 610 | type="irreversible", reaction_id="1")) 611 | gm_test <- tbl_graph(gm_test, gm_test_edges) 612 | return(gm_test) 613 | } else { 614 | ddx <- data.frame( 615 | name="hsa:51428", 616 | type="gene", 617 | reaction=NA, 618 | graphics_name="DDX41", 619 | x=500, y=-400, 620 | width=20,height=9, 621 | bgcolor="#BFFFBF", 622 | pathway_id="test" 623 | ) 624 | 625 | trim <- data.frame( 626 | name="hsa:6737", 627 | type="gene", 628 | reaction=NA, 629 | graphics_name="TRIM21", 630 | x=560, y=-400, 631 | width=20,height=9, 632 | bgcolor="#BFFFBF", 633 | pathway_id="test" 634 | ) 635 | 636 | nodes <- rbind(trim, ddx) 637 | nodes$xmin <- nodes$x-nodes$width/2 638 | nodes$ymin <- nodes$y-nodes$height/2 639 | nodes$xmax <- nodes$x+nodes$width/2 640 | nodes$ymax <- nodes$y+nodes$height/2 641 | 642 | edges <- rbind(c(from=1, to=2, 643 | subtype_name="degradation",pathway_id="test"), 644 | c(from=1, to=2, 645 | subtype_name="ubiquitination",pathway_id="test")) |> 646 | data.frame() 647 | edges$from <- as.integer(edges$from) 648 | edges$to <- as.integer(edges$to) 649 | tbl_graph(nodes, edges) 650 | } 651 | } 652 | 653 | -------------------------------------------------------------------------------- /R/plot_functions.R: -------------------------------------------------------------------------------- 1 | #' multi_pathway_native 2 | #' 3 | #' If you want to combine multiple KEGG pathways with their native coordinates, 4 | #' supply this function a vector of pathway IDs and row number. This returns the 5 | #' joined graph or list of graphs in which the coordinates are altered to panel 6 | #' the pathways. 7 | #' @param pathways pathway vector 8 | #' @param row_num row number 9 | #' @param return_list return list of graphs instead of joined graph 10 | #' @export 11 | #' @return graph adjusted for the position 12 | #' @examples 13 | #' ## Pass multiple pathway IDs 14 | #' multi_pathway_native(list("hsa04110","hsa03460")) 15 | #' 16 | multi_pathway_native <- function(pathways, row_num=2, return_list=FALSE) { 17 | plen <- length(pathways) 18 | 19 | if (plen %% 2) { 20 | col_num <- as.integer(plen / row_num)+1; addit <- plen %% row_num 21 | } else { 22 | col_num <- plen / row_num; addit <- 0 23 | } 24 | 25 | tot_row <- 1 26 | tot_col <- 1 27 | miny <- 0 28 | 29 | ## Preallocate 30 | gls <- vector(mode="list", length=plen) 31 | for (pp in seq_len(pathways |> length())) { 32 | g <- pathway(pathways[pp]) 33 | g <- g |> mutate(x=(.data$x/max(.data$x)+tot_col-1), 34 | y=.data$y/min(.data$y)+miny) 35 | gls[[pp]] <- g 36 | # edf <- g |> activate("nodes") |> data.frame() 37 | # miny <- miny - min(edf$y) 38 | tot_col <- tot_col + 1 39 | 40 | if (tot_col > col_num) { 41 | tot_col <- 1 42 | tot_row <- tot_row + 1 43 | miny <- miny - 1 44 | } 45 | # if (tot_row > row_num) { 46 | # tot_row <- 1 47 | # tot_col <- tot_col + 1 48 | # } 49 | } 50 | if (return_list) {return(gls)} 51 | Reduce(graph_join, gls) 52 | } 53 | 54 | #' plot_module_text 55 | #' 56 | #' plot the text representation of KEGG modules 57 | #' 58 | #' @param plot_list the result of `module_text()` 59 | #' @param show_name name column to be plotted 60 | #' @importFrom tidygraph tbl_graph 61 | #' @import patchwork 62 | #' @return ggplot2 object 63 | #' @export 64 | #' @examples 65 | #' 66 | #' mo <- create_test_module() 67 | #' 68 | #' ## The output of `module_text` is used for `plot_module_text()` 69 | #' tex <- module_text(mo) 70 | #' plt <- plot_module_text(tex) 71 | #' 72 | plot_module_text <- function(plot_list, show_name="name") { 73 | panel_list <- lapply(seq_along(plot_list), function(concat) { 74 | plot_list[[concat]]$name <- plot_list[[concat]][[show_name]] 75 | g <- tbl_graph(nodes=plot_list[[concat]]) 76 | ggraph(g, x=.data$x, y=1) + 77 | geom_node_rect(aes(filter=.data$koflag), 78 | fill=plot_list[[concat]][plot_list[[concat]]$koflag,]$color, 79 | alpha=0.5, color="black")+ 80 | geom_node_rect(aes(filter=!.data$koflag & !.data$conflag), 81 | fill="transparent", color="black")+ 82 | geom_node_text( 83 | aes(label=.data$name,filter=.data$koflag | .data$conflag))+ 84 | theme_void() 85 | }) 86 | wrap_plots(panel_list, ncol=1) 87 | } 88 | 89 | 90 | #' plot_module_blocks 91 | #' 92 | #' wrapper function for plotting network representation of 93 | #' module definition blocks 94 | #' 95 | #' @param all_steps the result of `obtain_sequential_module_definition()` 96 | #' @param layout ggraph layout parameter 97 | #' @export 98 | #' @return ggplot2 object 99 | #' @examples 100 | #' mo <- create_test_module() 101 | #' ## The output of `obtain_sequential_module_definition` 102 | #' ## is used for `plot_module_blocks()` 103 | #' sequential_mod <- obtain_sequential_module_definition(mo) 104 | #' plt <- plot_module_blocks(sequential_mod) 105 | plot_module_blocks <- function(all_steps, layout="kk") { 106 | allnodes <- unique(V(all_steps)$name) 107 | if (sum(startsWith(allnodes, "K"))==length(allnodes)) { 108 | stop("all nodes are KO.") 109 | } 110 | ggraph(all_steps, layout=layout) + 111 | geom_edge_link(aes(filter=.data$type %in% c("block_transition","rel")), 112 | end_cap=circle(5, 'mm'),start_cap=circle(5,"mm"), 113 | color="red")+ 114 | geom_edge_link(aes(filter=!.data$type %in% 115 | c("block_transition","rel","in_block"))) + 116 | geom_edge_link(aes(label=.data$type, 117 | filter=!startsWith(.data$type,"in") & 118 | !.data$type %in% c("block_transition","rel")), 119 | angle_calc="along", 120 | label_dodge=unit(2, 'mm')) + 121 | geom_node_point(size=4, 122 | aes(filter=!startsWith(.data$name,"manual_BLOCK") & 123 | !startsWith(.data$name,"manual_G") & 124 | !startsWith(.data$name,"manual_CS"))) + 125 | geom_node_point(size=2, shape=21, 126 | aes(filter=startsWith(.data$name,"manual_BLOCK"))) + 127 | geom_node_point(size=2, shape=21, 128 | aes(filter=startsWith(.data$name,"manual_CS") | 129 | startsWith(.data$name,"manual_G"))) + 130 | geom_node_text(aes(label=.data$name, 131 | filter=startsWith(.data$name,"K")), 132 | repel=TRUE, size=4, bg.colour="white")+ 133 | theme_void() 134 | } 135 | 136 | #' geom_node_shadowtext 137 | #' 138 | #' Plot shadowtext at node position, use StatFilter in ggraph 139 | #' 140 | #' @export 141 | #' @param mapping aes mapping 142 | #' @param data data to plot 143 | #' @param position positional argument 144 | #' @param show.legend whether to show legend 145 | #' @param ... passed to `params` in `layer()` function 146 | #' @return geom 147 | #' @importFrom shadowtext GeomShadowText 148 | #' @examples 149 | #' test_pathway <- create_test_pathway() 150 | #' plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 151 | #' geom_node_shadowtext(aes(label=name)) 152 | geom_node_shadowtext <- function(mapping=NULL, data=NULL, 153 | position='identity', 154 | show.legend=NA, ...) { 155 | params <- list(na.rm=FALSE, ...) 156 | 157 | mapping <- c(mapping, aes(x=.data$x, y=.data$y)) 158 | class(mapping) <- "uneval" 159 | 160 | layer( 161 | data=data, mapping=mapping, stat=StatFilter, geom=GeomShadowText, 162 | position=position, show.legend=show.legend, inherit.aes=FALSE, 163 | params=params 164 | ) 165 | } 166 | 167 | #' geom_node_rect 168 | #' 169 | #' Plot rectangular shapes to ggplot2 using GeomRect, 170 | #' using StatFilter in ggraph 171 | #' 172 | #' @param mapping aes mapping 173 | #' @param data data to plot 174 | #' @param position positional argument 175 | #' @param show.legend whether to show legend 176 | #' @param ... passed to `params` in `layer()` function 177 | #' @return geom 178 | #' @export 179 | #' @examples 180 | #' test_pathway <- create_test_pathway() 181 | #' plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 182 | #' geom_node_rect() 183 | geom_node_rect <- function(mapping=NULL, data=NULL, position='identity', 184 | show.legend=NA, ...) { 185 | mapping1 <- mapping 186 | raw_mapping <- aes(xmin=.data$xmin, ymin=.data$ymin, xmax=.data$xmax, ymax=.data$ymax) 187 | mapping <- c(as.list(mapping1), raw_mapping[!names(raw_mapping) %in% names(mapping1)]) 188 | class(mapping) <- "uneval" 189 | layer( 190 | data=data, mapping=mapping, stat=StatFilter, geom=GeomRect, 191 | position=position, show.legend=show.legend, inherit.aes=FALSE, 192 | params=list(na.rm=FALSE, ...) 193 | ) 194 | } 195 | 196 | 197 | #' geom_node_rect_kegg 198 | #' 199 | #' Wrapper function for plotting a certain type of nodes 200 | #' with background color with geom_node_rect() 201 | #' 202 | #' @param type type to be plotted (gene, map, compound ...) 203 | #' @param rect_fill rectangular fill 204 | #' @export 205 | #' @return ggplot2 object 206 | #' @examples 207 | #' test_pathway <- create_test_pathway() 208 | #' plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 209 | #' geom_node_rect_kegg(type="gene") 210 | geom_node_rect_kegg <- function(type=NULL, rect_fill="grey") { 211 | structure(list(type=type, rect_fill=rect_fill), 212 | class="geom_node_rect_kegg") 213 | } 214 | 215 | #' ggplot_add.geom_node_rect_kegg 216 | #' @param object An object to add to the plot 217 | #' @param plot The ggplot object to add object to 218 | #' @param object_name The name of the object to add 219 | #' @export ggplot_add.geom_node_rect_kegg 220 | #' @export 221 | #' @return ggplot2 object 222 | #' @examples 223 | #' test_pathway <- create_test_pathway() 224 | #' plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 225 | #' geom_node_rect_kegg(type="gene") 226 | ggplot_add.geom_node_rect_kegg <- function(object, plot, object_name) { 227 | if (is.null(object$type)){ 228 | type <- unique(plot$data$type) 229 | type <- type[type!="group"] 230 | } else { 231 | type <- object$type 232 | } 233 | if (!is.null(plot$data$undefined)) { 234 | plot <- plot + geom_node_rect(aes(filter=.data$undefined), 235 | fill="transparent", color="red") 236 | plot <- plot + geom_node_rect( 237 | aes(filter=.data$undefined & .data$type %in% type), 238 | fill=object$rect_fill, color="black") 239 | 240 | } else { 241 | plot <- plot + geom_node_rect(aes(filter=.data$type %in% type), 242 | fill=object$rect_fill, color="black") 243 | } 244 | plot 245 | } 246 | 247 | 248 | #' plot_kegg_network 249 | #' 250 | #' plot the output of network_graph 251 | #' 252 | #' @param g graph object returned by `network()` 253 | #' @param layout layout to be used, default to nicely 254 | #' @return ggplot2 object 255 | #' @export 256 | #' @examples 257 | #' ne <- create_test_network() 258 | #' ## Output of `network_graph` must be used with plot_kegg_network 259 | #' neg <- network_graph(ne) 260 | #' plt <- plot_kegg_network(neg) 261 | plot_kegg_network <- function(g, layout="nicely") { 262 | gg <- g |> as_tbl_graph() |> activate("nodes") |> 263 | mutate(splitn=strsplit(.data$name,"_") |> 264 | vapply("[",1,FUN.VALUE="character")) |> 265 | mutate(group=startsWith(.data$splitn,"manual_G"), 266 | and_group=startsWith(.data$splitn,"manual_CS")) 267 | 268 | ggraph(gg, layout=layout) + 269 | geom_edge_link(aes(label=.data$type, 270 | filter=!startsWith(.data$type,"in")), 271 | angle_calc="along", force_flip=FALSE, 272 | label_dodge=unit(2, 'mm')) + 273 | geom_edge_link(aes(filter=startsWith(.data$type,"in_and")))+ 274 | geom_edge_link(aes(filter=startsWith(.data$type,"in_block")), 275 | linetype=2)+ 276 | geom_node_point(size=4, 277 | aes(filter=!startsWith(.data$name,"manual_BLOCK") & 278 | !(.data$group)& 279 | !(.data$and_group))) + 280 | geom_node_point(size=2, shape=21, 281 | aes(filter=startsWith(.data$name,"manual_BLOCK"))) + 282 | geom_node_point(size=2, shape=21, 283 | aes(filter=(.data$group) | (.data$and_group))) + 284 | geom_node_text(aes(label=.data$name, 285 | filter=!startsWith(.data$name,"manual_")), 286 | repel=TRUE, size=4, bg.colour="white") + 287 | theme_void() 288 | } 289 | 290 | 291 | #' geom_node_rect_multi 292 | #' 293 | #' Wrapper function for plotting multiple rects 294 | #' with background color with geom_node_rect(). 295 | #' All columns should belong to the same scale when 296 | #' using `asIs=FALSE`. If you need multiple scales for 297 | #' each element, please use `ggh4x::scale_fill_multi` 298 | #' for each. 299 | #' 300 | #' @param ... color columns 301 | #' @param asIs treat the color as is or not 302 | #' @export 303 | #' @return ggplot2 object 304 | #' @examples 305 | #' plt <- create_test_pathway() %>% ggraph() + geom_node_rect_multi(bgcolor) 306 | geom_node_rect_multi <- function(..., asIs=TRUE) { 307 | color_cols <- as.character(ensyms(...)) 308 | structure(list(cols=color_cols, asIs=asIs), 309 | class="geom_node_rect_multi")} 310 | 311 | #' ggplot_add.geom_node_rect_multi 312 | #' @param object An object to add to the plot 313 | #' @param plot The ggplot object to add object to 314 | #' @param object_name The name of the object to add 315 | #' @export ggplot_add.geom_node_rect_multi 316 | #' @export 317 | #' @return ggplot2 object 318 | #' @examples 319 | #' plt <- create_test_pathway() %>% ggraph() + geom_node_rect_multi(bgcolor) 320 | ggplot_add.geom_node_rect_multi <- function(object, plot, object_name) { 321 | colnum <- length(object$cols) 322 | if (length(colnum)==0) {stop("Please specify at least one color column")} 323 | plot$data$space <- plot$data$width / colnum 324 | for (i in seq_len(colnum)) { 325 | if (object$asIs) { 326 | plot <- plot + 327 | geom_node_rect( 328 | aes(xmin= .data$xmin + .data$space*!!(i-1), 329 | xmax= .data$xmin + .data$space*!!(i), 330 | fill= I(.data[[object$cols[i]]]))) 331 | } else { 332 | plot <- plot + 333 | geom_node_rect( 334 | aes(xmin= .data$xmin + .data$space*!!(i-1), 335 | xmax= .data$xmin + .data$space*!!(i), 336 | fill= .data[[object$cols[i]]])) 337 | } 338 | } 339 | plot 340 | } 341 | 342 | 343 | #' geom_kegg 344 | #' 345 | #' Wrapper function for plotting KEGG pathway graph 346 | #' add geom_node_rect, geom_node_text and geom_edge_link simultaneously 347 | #' 348 | #' @param edge_color color attribute to edge 349 | #' @param group_color border color for group node rectangles 350 | #' @param node_label column name for node label 351 | #' @param parallel use geom_edge_parallel() instead of geom_edge_link() 352 | #' @export 353 | #' @examples 354 | #' test_pathway <- create_test_pathway() 355 | #' p <- ggraph(test_pathway, layout="manual", x=x, y=y)+ 356 | #' geom_kegg() 357 | #' @return ggplot2 object 358 | geom_kegg <- function(edge_color=NULL, 359 | node_label=.data$name, 360 | group_color="red", 361 | parallel=FALSE) { 362 | structure(list(edge_color=edge_color, 363 | node_label=enquo(node_label), 364 | group_color=group_color, 365 | parallel=parallel), 366 | class="geom_kegg") 367 | } 368 | 369 | #' ggplot_add.geom_kegg 370 | #' @param object An object to add to the plot 371 | #' @param plot The ggplot object to add object to 372 | #' @param object_name The name of the object to add 373 | #' @export ggplot_add.geom_kegg 374 | #' @return ggplot2 object 375 | #' @export 376 | #' @examples 377 | #' test_pathway <- create_test_pathway() 378 | #' p <- ggraph(test_pathway, layout="manual", x=x, y=y)+ 379 | #' geom_kegg() 380 | ggplot_add.geom_kegg <- function(object, plot, object_name) { 381 | if (object$parallel) { 382 | plot <- plot + 383 | geom_edge_parallel(width=0.5, 384 | arrow=arrow(length=unit(1, 'mm')), 385 | start_cap=square(1, 'cm'), 386 | end_cap=square(1.5, 'cm')) 387 | } else { 388 | plot <- plot + 389 | geom_edge_link(width=0.5, 390 | arrow=arrow(length=unit(1, 'mm')), 391 | start_cap=square(1, 'cm'), 392 | end_cap=square(1.5, 'cm')) 393 | } 394 | 395 | plot <- plot + geom_node_rect(aes(filter=.data$type=="group"), 396 | fill="transparent", color=object$group_color) 397 | plot <- plot + geom_node_rect(aes(fill=I(.data$bgcolor), 398 | filter=.data$bgcolor!="none" & .data$type!="group")) 399 | plot <- plot + 400 | geom_node_text(aes(label=!!object$node_label, 401 | filter=.data$type!="group"), family="serif", size=2) + 402 | theme_void() 403 | 404 | } -------------------------------------------------------------------------------- /R/stamp.R: -------------------------------------------------------------------------------- 1 | #' stamp 2 | #' 3 | #' place stamp on the specified node 4 | #' 5 | #' @param name name of the nodes 6 | #' @param color color of the stamp 7 | #' @param which_column which node column to search 8 | #' @param xval adjustment value for x-axis 9 | #' @param yval adjustment value for y-axis 10 | #' @export 11 | #' @return ggplot2 object 12 | #' @examples 13 | #' test_pathway <- create_test_pathway() 14 | #' plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 15 | #' stamp("hsa:6737") 16 | stamp <- function(name, color="red", which_column="name", xval=2, yval=2) { 17 | structure(list(name=name, color=color, which_column=which_column, xval=xval, yval=yval), 18 | class="stamp") 19 | } 20 | 21 | #' ggplot_add.stamp 22 | #' @param object An object to add to the plot 23 | #' @param plot The ggplot object to add object to 24 | #' @param object_name The name of the object to add 25 | #' @export ggplot_add.geom_node_rect_kegg 26 | #' @export 27 | #' @return ggplot2 object 28 | #' @examples 29 | #' test_pathway <- create_test_pathway() 30 | #' plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 31 | #' stamp("hsa:6737") 32 | ggplot_add.stamp <- function(object, plot, object_name) { 33 | plot <- plot + geom_node_rect(aes(xmin=.data$xmin-object$xval, xmax=.data$xmax+object$xval, 34 | ymin=.data$ymin-object$yval, ymax=.data$ymax+object$yval, 35 | filter=.data[[object$which_column]] %in% object$name), 36 | fill="transparent", color=object$color) 37 | plot 38 | } 39 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) 2 | 3 | #' find_parenthesis_pairs 4 | #' find pairs of parenthesis 5 | #' @noRd 6 | find_parenthesis_pairs <- function(s) { 7 | ## Preallocate 8 | stack <- integer(nchar(s)) 9 | pairs <- vector(mode="list", length=nchar(s)/2) 10 | j <- 1 11 | for (i in seq_len(nchar(s))) { 12 | c <- substr(s, i, i) 13 | if (c == "(") { 14 | stack[i] <- 1 15 | } else if (c == ")") { 16 | if (length(which(stack==1)) == 0) { 17 | stop("Mismatched parenthesis") 18 | } 19 | open <- tail(which(stack==1), 1) 20 | stack[open] <- 0 21 | pairs[[j]] <- c(open, i) 22 | j <- j+1 23 | } 24 | } 25 | if (length(which(stack==1)) > 0) { 26 | stop("Mismatched parenthesis") 27 | } 28 | pairs[vapply(pairs, is.null, TRUE)] <- NULL 29 | pairs 30 | } 31 | 32 | 33 | #' append_label_position 34 | #' 35 | #' Append the label position at center of edges 36 | #' in global map like ko01100 where line type nodes 37 | #' are present in KGML. 38 | #' Add `center` column to graph edge. 39 | #' 40 | #' @param g graph 41 | #' @importFrom dplyr mutate summarise group_by filter 42 | #' @importFrom dplyr row_number n distinct ungroup 43 | #' @importFrom stats setNames 44 | #' @return tbl_graph 45 | #' @examples 46 | #' ## Simulate nodes containing `graphics_type` of line and `coords` 47 | #' gm_test <- data.frame(name="ko:K00112",type="ortholog",reaction="rn:R00112", 48 | #' graphics_name="K00112",fgcolor="#ff0000",bgcolor="#ffffff", 49 | #' graphics_type="line",coords="1,2,3,4",orig.id=1,pathway_id="test") 50 | #' gm_test <- tbl_graph(gm_test) 51 | #' test <- process_line(gm_test) |> append_label_position() 52 | #' @export 53 | append_label_position <- function(g) { 54 | pos <- g |> 55 | activate(edges) |> 56 | data.frame() |> 57 | filter(.data$type=="line") |> 58 | group_by(.data$orig.id) |> 59 | summarise(n=n()) |> 60 | mutate(n2=n/2) |> 61 | mutate(n3=as.integer(.data$n2+1)) 62 | 63 | posvec <- pos$n3 |> setNames(pos$orig.id) 64 | g |> activate(edges) |> group_by(.data$orig.id) |> 65 | mutate(rn=row_number()) |> ungroup() |> 66 | mutate(showpos=edge_numeric(name="orig.id", posvec)) |> 67 | mutate(center=.data$rn==.data$showpos) |> 68 | mutate(rn=NULL, showpos=NULL) 69 | } 70 | 71 | #' return_line_compounds 72 | #' 73 | #' In the map, where lines are converted to edges, 74 | #' identify compounds that are linked by the reaction. 75 | #' Give the original edge ID of KGML (orig.id in edge table), and 76 | #' return the original compound node ID 77 | #' 78 | #' @param g tbl_graph object 79 | #' @param orig original edge ID 80 | #' @return vector of original compound node IDs 81 | #' @export 82 | #' @examples 83 | #' ## For those containing nodes with the graphic type of `line` 84 | #' ## This returns no IDs as no edges are present 85 | #' gm_test <- create_test_pathway(line=TRUE) 86 | #' test <- process_line(gm_test) |> return_line_compounds(1) 87 | return_line_compounds <- function(g, orig) { 88 | ndf <- g |> activate("nodes") |> data.frame() 89 | edf <- g |> activate("edges") |> data.frame() 90 | highl <- ndf[edf[edf$to %in% as.integer(ndf[ndf$orig.id %in% orig,] |> 91 | row.names()),]$from,]$orig.id 92 | highl2 <- ndf[edf[edf$from %in% as.integer(ndf[ndf$orig.id %in% orig,] |> 93 | row.names()),]$to,]$orig.id 94 | c(highl, highl2) 95 | } 96 | 97 | #' edge_numeric 98 | #' 99 | #' add numeric attribute to edge of tbl_graph 100 | #' 101 | #' @param num named vector or tibble with id and value column 102 | #' @param num_combine how to combine number when multiple hit in the same node 103 | #' @param name name of column to match for 104 | #' @param sep separater for name, default to " " 105 | #' @param remove_dot remove "..." in the name 106 | #' @param how `any` or `all` 107 | #' @export 108 | #' @return numeric vector 109 | #' @importFrom tibble is_tibble 110 | #' @importFrom tidygraph activate 111 | #' @examples 112 | #' graph <- create_test_pathway() 113 | #' graph <- graph |> activate("edges") |> 114 | #' mutate(num=edge_numeric(c(1.1) |> 115 | #' setNames("degradation"), name="subtype_name")) 116 | edge_numeric <- function(num, num_combine=mean, how="any", name="name", 117 | sep=" ", remove_dot=TRUE) { 118 | graph <- .G() 119 | if (!is_tibble(num) & !is.vector(num)) { 120 | stop("Please provide tibble or named vector") 121 | } 122 | if (is_tibble(num)) { 123 | if (duplicated(num$id) |> unique() |> length() > 1) { 124 | stop("Duplicate ID found") 125 | } 126 | changer <- num$value 127 | names(changer) <- num$id 128 | } else { 129 | if (duplicated(names(num)) |> unique() |> length() > 1) { 130 | stop("Duplicate ID found") 131 | } 132 | changer <- num 133 | } 134 | 135 | x <- get.edge.attribute(graph, name) 136 | 137 | lapply(x, function(xx) { 138 | in_node <- strsplit(xx, sep) |> unlist() |> unique() 139 | if (remove_dot) { 140 | in_node <- lapply(in_node, function(nn) { 141 | strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 142 | }) %>% unlist() 143 | } 144 | thresh <- ifelse(how == "any", 1, length(in_node)) 145 | if (length(intersect(names(changer), in_node)) >= thresh) { 146 | summed <- do.call(num_combine, 147 | list(x=changer[intersect(names(changer), in_node)])) 148 | } else { 149 | summed <- NA 150 | } 151 | return(summed) 152 | }) |> unlist() 153 | } 154 | 155 | 156 | #' edge_numeric_sum 157 | #' 158 | #' add numeric attribute to edge of tbl_graph based on node values 159 | #' The implementation is based on the paper by 160 | #' Adnan et al. 2020 (https://doi.org/10.1186/s12859-020-03692-2). 161 | #' 162 | #' @param num named vector or tibble with id and value column 163 | #' @param num_combine how to combine number when multiple hit in the same node 164 | #' @param name name of column to match for 165 | #' @param sep separater for name, default to " " 166 | #' @param remove_dot remove "..." in the name 167 | #' @param how `any` or `all` 168 | #' @export 169 | #' @return numeric vector 170 | #' @importFrom tibble is_tibble 171 | #' @importFrom tidygraph activate 172 | #' @examples 173 | #' graph <- create_test_pathway() 174 | #' graph <- graph |> 175 | #' activate("edges") |> 176 | #' mutate(num=edge_numeric_sum(c(1.2,-1.2) |> 177 | #' setNames(c("TRIM21","DDX41")), name="graphics_name")) 178 | edge_numeric_sum <- function(num, num_combine=mean, how="any", name="name", 179 | sep=" ", remove_dot=TRUE) { 180 | graph <- .G() 181 | 182 | if (!is_tibble(num) & !is.vector(num)) { 183 | stop("Please provide tibble or named vector") 184 | } 185 | if (is_tibble(num)) { 186 | if (duplicated(num$id) |> unique() |> length() > 1) { 187 | stop("Duplicate ID found") 188 | } 189 | changer <- num$value 190 | names(changer) <- num$id 191 | } else { 192 | if (duplicated(names(num)) |> unique() |> length() > 1) { 193 | stop("Duplicate ID found") 194 | } 195 | changer <- num 196 | } 197 | 198 | node_df <- graph |> activate("nodes") |> data.frame() 199 | node_name <- node_df[[name]] 200 | new_graph <- graph |> activate(edges) |> 201 | mutate(from_nd=node_name[.data$from], to_nd=node_name[.data$to]) |> 202 | mutate(summed=edge_numeric(num, num_combine, how, name="from_nd", sep=sep, remove_dot=remove_dot)+ 203 | edge_numeric(num, num_combine, how, name="to_nd", sep=sep, remove_dot=remove_dot)) |> 204 | data.frame() 205 | new_graph$summed 206 | } 207 | 208 | 209 | #' node_numeric 210 | #' 211 | #' simply add numeric attribute to node of tbl_graph 212 | #' 213 | #' @param num named vector or tibble with id and value column 214 | #' @param num_combine how to combine number when multiple hit in the same node 215 | #' @param how how to match the node IDs with the queries 'any' or 'all' 216 | #' @param name name of column to match for 217 | #' @param sep separater for name, default to " " 218 | #' @param remove_dot remove "..." in the name 219 | #' @export 220 | #' @return numeric vector 221 | #' @importFrom tibble is_tibble 222 | #' @examples 223 | #' graph <- create_test_pathway() 224 | #' graph <- graph |> 225 | #' mutate(num=node_numeric(c(1.1) |> setNames("hsa:6737"))) 226 | #' 227 | node_numeric <- function(num, num_combine=mean, 228 | name="name", how="any", sep=" ", remove_dot=TRUE) { 229 | graph <- .G() 230 | if (!is_tibble(num) & !is.vector(num)) { 231 | stop("Please provide tibble or named vector") 232 | } 233 | if (is_tibble(num)) { 234 | if (duplicated(num$id) |> unique() |> length() > 1) { 235 | stop("Duplicate ID found") 236 | } 237 | changer <- num$value 238 | names(changer) <- num$id 239 | } else { 240 | if (duplicated(names(num)) |> unique() |> length() > 1) { 241 | stop("Duplicate ID found") 242 | } 243 | changer <- num 244 | } 245 | x <- get.vertex.attribute(graph, name) 246 | 247 | lapply(x, function(xx) { 248 | in_node <- strsplit(xx, sep) |> unlist() |> unique() 249 | if (remove_dot) { 250 | in_node <- lapply(in_node, function(nn) { 251 | strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 252 | }) %>% unlist() 253 | } 254 | thresh <- ifelse(how=="any", 1, length(in_node)) 255 | if (length(intersect(names(changer), in_node)) >= thresh) { 256 | summed <- do.call(num_combine, 257 | list(x=changer[intersect(names(changer), in_node)])) 258 | } else { 259 | summed <- NA 260 | } 261 | }) |> unlist() 262 | } 263 | 264 | 265 | #' node_matrix 266 | #' 267 | #' given the matrix representing gene as row and sample as column, 268 | #' append the node value to node matrix and 269 | #' return tbl_graph object 270 | #' 271 | #' @param graph tbl_graph to append values to 272 | #' @param mat matrix representing gene as row and sample as column 273 | #' @param gene_type gene ID of matrix row 274 | #' @param org organism ID to convert ID 275 | #' @param org_db organism database to convert ID 276 | #' @param num_combine function to combine multiple numeric values 277 | #' @param name name column in node data, default to node 278 | #' @param sep separater of name, default to " " 279 | #' @param remove_dot remove "..." in the name 280 | #' @export 281 | #' @return tbl_graph 282 | #' @examples 283 | #' 284 | #' ## Append data.frame to tbl_graph 285 | #' graph <- create_test_pathway() 286 | #' num_df <- data.frame(row.names=c("6737","51428"), 287 | #' "sample1"=c(1.1,1.2), 288 | #' "sample2"=c(1.5,2.2), 289 | #' check.names=FALSE) 290 | #' graph <- graph |> node_matrix(num_df, gene_type="ENTREZID") 291 | #' 292 | node_matrix <- function(graph, mat, gene_type="SYMBOL", org="hsa", 293 | org_db=NULL, num_combine=mean, name="name", 294 | sep=" ", remove_dot=TRUE) { 295 | get_value <- function(x) { 296 | val <- lapply(seq_along(x), function(xx) { 297 | if (x[xx]=="undefined") {return(NA)} 298 | vals <- strsplit(x[xx], sep) |> unlist() |> unique() 299 | if (remove_dot) { 300 | vals <- lapply(vals, function(nn) { 301 | strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 302 | }) %>% unlist() 303 | } 304 | subset_conv <- convert_df |> 305 | filter(.data$converted %in% vals) |> 306 | data.frame() 307 | if (dim(subset_conv)[1]==0) {return(NA)} 308 | if (dim(subset_conv)[1]==1) { 309 | return(mat[subset_conv[[gene_type]],]) 310 | } 311 | return(apply(mat[ subset_conv[[gene_type]],], 2, num_combine)) 312 | }) 313 | binded <- do.call(rbind, val) 314 | binded 315 | } 316 | 317 | node_df <- graph |> activate("nodes") |> data.frame() 318 | node_name <- node_df[[name]] 319 | if (gene_type!="ENTREZID") { 320 | if (!requireNamespace("AnnotationDbi")) { 321 | stop("This conversion requires AnnotationDbi.") 322 | } 323 | if (is.null(org_db)) { 324 | stop("Please specify Annotation DB to org_db.") 325 | } 326 | convert_df <- mat %>% 327 | row.names() %>% 328 | AnnotationDbi::mapIds(x=org_db, keys=., 329 | column="ENTREZID", keytype=gene_type) %>% 330 | tibble::enframe() %>% 331 | `colnames<-`(c(gene_type, "ENTREZID")) 332 | } else { 333 | convert_df <- data.frame(row.names(mat)) %>% `colnames<-`(c("ENTREZID")) 334 | } 335 | 336 | convert_df$converted <- paste0(org, ":", convert_df[["ENTREZID"]]) 337 | new_edges <- graph |> activate("edges") |> data.frame() 338 | summed <- data.frame(get_value(node_df[[name]])) 339 | new_nodes <- cbind(node_df, summed) 340 | appended <- tbl_graph(nodes=new_nodes, edges=new_edges) 341 | appended 342 | } 343 | 344 | #' edge_matrix 345 | #' 346 | #' given the matrix representing gene as row and sample as column, 347 | #' append the edge value (sum of values of connecting nodes) to edge matrix and 348 | #' return tbl_graph object. The implementation is based on the paper by 349 | #' Adnan et al. 2020 (https://doi.org/10.1186/s12859-020-03692-2). 350 | #' 351 | #' @param graph tbl_graph to append values to 352 | #' @param mat matrix representing gene as row and sample as column 353 | #' @param gene_type gene ID of matrix row 354 | #' @param org organism ID to convert ID 355 | #' @param org_db organism database to convert ID 356 | #' @param num_combine function to combine multiple numeric values 357 | #' @param name name column in node data, default to node 358 | #' @param sep separater of name, default to " " 359 | #' @param remove_dot remove "..." in node name 360 | #' @export 361 | #' @return tbl_graph 362 | #' @examples 363 | #' graph <- create_test_pathway() 364 | #' num_df <- data.frame(row.names=c("6737","51428"), 365 | #' "sample1"=c(1.1,1.2), 366 | #' "sample2"=c(1.1,1.2), 367 | #' check.names=FALSE) 368 | #' graph <- graph %>% edge_matrix(num_df, gene_type="ENTREZID") 369 | edge_matrix <- function(graph, mat, gene_type="SYMBOL", org="hsa", 370 | org_db=NULL, num_combine=mean, name="name", sep=" ", remove_dot=TRUE) { 371 | get_value <- function(x) { 372 | val <- lapply(seq_along(x), function(xx) { 373 | if (x[xx]=="undefined") {return(NA)} 374 | vals <- strsplit(x[xx], " ") %>% unlist() %>% unique() 375 | if (remove_dot) { 376 | vals <- lapply(vals, function(nn) { 377 | strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 378 | }) %>% unlist() 379 | } 380 | subset_conv <- convert_df %>% filter(.data$converted %in% vals) %>% 381 | data.frame() 382 | if (dim(subset_conv)[1]==0) { 383 | return(NA) 384 | } 385 | if (dim(subset_conv)[1]==1) { 386 | return(mat[subset_conv[[gene_type]],]) 387 | } 388 | return(apply(mat[ subset_conv[[gene_type]],], 2, num_combine)) 389 | }) 390 | binded <- do.call(rbind, val) 391 | binded 392 | } 393 | 394 | node_df <- graph %>% activate("nodes") %>% data.frame() 395 | node_name <- node_df$name 396 | if (gene_type!="ENTREZID") { 397 | if (!requireNamespace("AnnotationDbi")) { 398 | stop("This conversion requires AnnotationDbi.") 399 | } 400 | if (is.null(org_db)) { 401 | stop("Please specify Annotation DB to org_db.") 402 | } 403 | convert_df <- mat %>% 404 | row.names() %>% 405 | AnnotationDbi::mapIds(x=org_db, keys=., 406 | column="ENTREZID", keytype=gene_type) %>% 407 | tibble::enframe() %>% 408 | `colnames<-`(c(gene_type, "ENTREZID")) 409 | } else { 410 | convert_df <- data.frame(row.names(mat)) %>% `colnames<-`(c("ENTREZID")) 411 | } 412 | 413 | convert_df$converted <- paste0(org, ":", convert_df[["ENTREZID"]]) 414 | new_graph <- graph %>% activate(edges) %>% 415 | mutate(from_nd=node_name[.data$from], to_nd=node_name[.data$to]) %>% 416 | data.frame() 417 | summed <- data.frame( 418 | get_value(new_graph$from_nd) + get_value(new_graph$to_nd)) 419 | new_edges <- cbind(new_graph, summed) 420 | appended <- tbl_graph(nodes=node_df, edges=new_edges) 421 | appended 422 | } 423 | 424 | #' append_cp 425 | #' 426 | #' append clusterProfiler results to graph 427 | #' 428 | #' @param res enrichResult class 429 | #' @param how how to determine whether the nodes is in enrichment results 430 | #' @param name name column to search for query 431 | #' @param sep separater for name 432 | #' @param remove_dot remove dots in the name 433 | #' @param pid pathway ID, if NULL, try to infer from graph attribute 434 | #' @param infer if TRUE, append the prefix to queried IDs based on pathway ID 435 | #' @return enrich_attribute column in node 436 | #' @examples 437 | #' graph <- create_test_pathway() 438 | #' nodes <- graph |> data.frame() 439 | #' if (require("clusterProfiler")) { 440 | #' cp <- enrichKEGG(nodes$name |> 441 | #' strsplit(":") |> 442 | #' vapply("[", 2, FUN.VALUE="character")) 443 | #' ## This append graph node logical value whether the 444 | #' ## enriched genes are in pathway 445 | #' graph <- graph |> mutate(cp=append_cp(cp, pid="hsa05322")) 446 | #' } 447 | #' @export 448 | #' 449 | append_cp <- function(res, how="any", name="name", pid=NULL, infer=FALSE, sep=" ", remove_dot=TRUE) { 450 | if (!attributes(res)$class %in% c("enrichResult","gseaResult")) { 451 | stop("Please provide enrichResult or gseaResult class object") 452 | } 453 | if (attributes(res)$class=="gseaResult") { 454 | gene_col <- "core_enrichment" 455 | } else { 456 | gene_col <- "geneID" 457 | } 458 | graph <- .G() 459 | if (is.null(pid)) { 460 | pid <- unique(V(graph)$pathway_id) 461 | } 462 | x <- get.vertex.attribute(graph, name) 463 | org <- attributes(res)$organism 464 | res <- attributes(res)$result 465 | 466 | if (name=="graphics_name") { 467 | ## If graphics name, use as is. 468 | enrich_attribute <- unlist(strsplit(res[pid,][[gene_col]], "/")) 469 | } else { 470 | if (org!="UNKNOWN") { 471 | if (org=="microbiome") {org <- "ko"; pid <- gsub("ko","map",pid)} 472 | enrich_attribute <- paste0(org, ":", unlist(strsplit( 473 | res[pid,][[gene_col]], "/"))) 474 | } else {## If UNKNOWN 475 | ## Try to infer 476 | if (infer) { 477 | org <- gsub("[^a-zA-Z]", "", pid) 478 | enrich_attribute <- paste0(org, ":", unlist(strsplit(res[pid,][[gene_col]], "/"))) 479 | } else { 480 | enrich_attribute <- unlist(strsplit(res[pid,][[gene_col]], "/")) 481 | } 482 | } 483 | } 484 | bools <- vapply(x, function(xx) { 485 | in_node <- strsplit(xx, sep) |> unlist() |> unique() 486 | if (remove_dot) { 487 | in_node <- lapply(in_node, function(nn) { 488 | strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 489 | }) %>% unlist() 490 | } 491 | if (how=="any") { 492 | if (length(intersect(in_node, enrich_attribute))>=1) { 493 | return(TRUE) 494 | } else { 495 | return(FALSE) 496 | } 497 | } else { 498 | if (length(intersect(in_node, enrich_attribute))==length(in_node)) { 499 | return(TRUE) 500 | } else { 501 | return(FALSE) 502 | } 503 | } 504 | }, FUN.VALUE=TRUE) 505 | bools 506 | } 507 | 508 | 509 | 510 | #' assign_deseq2 511 | #' 512 | #' assign DESeq2 numerical values to nodes 513 | #' 514 | #' @param res The result() of DESeq() 515 | #' @param column column of the numeric attribute, default to log2FoldChange 516 | #' @param gene_type default to SYMBOL 517 | #' @param org_db organism database to convert ID to ENTREZID 518 | #' @param org organism ID in KEGG 519 | #' @param numeric_combine how to combine multiple numeric values 520 | #' @param name column name for ID in tbl_graph nodes 521 | #' @param sep for node name 522 | #' @param remove_dot remove dot in the name 523 | #' @return numeric vector 524 | #' @export 525 | #' @examples 526 | #' graph <- create_test_pathway() 527 | #' res <- data.frame(row.names="6737",log2FoldChange=1.2) 528 | #' graph <- graph |> mutate(num=assign_deseq2(res, gene_type="ENTREZID")) 529 | assign_deseq2 <- function(res, column="log2FoldChange", 530 | gene_type="SYMBOL", 531 | org_db=NULL, org="hsa", 532 | numeric_combine=mean, 533 | name="name", sep=" ", remove_dot=TRUE) { 534 | graph <- .G() 535 | if (gene_type!="ENTREZID") { 536 | if (!requireNamespace("AnnotationDbi")) { 537 | stop("This conversion requires AnnotationDbi.") 538 | } 539 | if (is.null(org_db)) { 540 | stop("Please specify Annotation DB to org_db.") 541 | } 542 | convert_df <- res %>% 543 | row.names() %>% 544 | AnnotationDbi::mapIds(x=org_db, keys=., 545 | column="ENTREZID", keytype=gene_type) %>% 546 | tibble::enframe() %>% 547 | `colnames<-`(c(gene_type, "ENTREZID")) 548 | nums <- data.frame(row.names(res), res[[column]]) |> 549 | `colnames<-`(c(gene_type, column)) 550 | merged <- merge(nums, convert_df, by=gene_type) 551 | } else { 552 | merged <- data.frame(row.names(res), res[[column]]) |> 553 | `colnames<-`(c("ENTREZID", column)) 554 | } 555 | merged$converted <- paste0(org, ":", merged[["ENTREZID"]]) 556 | changer <- merged[[column]] |> `names<-`(merged[["converted"]]) 557 | x <- get.vertex.attribute(graph, name) 558 | lapply(x, function(xx) { 559 | in_node <- strsplit(xx, sep) |> unlist() |> unique() 560 | if (remove_dot) { 561 | in_node <- lapply(in_node, function(nn) { 562 | strsplit(nn, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 563 | }) %>% unlist() 564 | } 565 | do.call(numeric_combine, 566 | list(x=changer[intersect(in_node, names(changer))])) 567 | }) |> unlist() 568 | } 569 | 570 | 571 | 572 | #' convert_id 573 | #' 574 | #' convert the identifier using retrieved information 575 | #' 576 | #' @param org which identifier to convert 577 | #' @param name which column to convert in edge or node table 578 | #' @param convert_column which column is parsed in 579 | #' obtained data frame from KEGG REST API or local file 580 | #' @param colon whether the original ids include colon (e.g. `ko:`) 581 | #' If `NULL`, automatically set according to `org` 582 | #' @param first_arg_comma take first argument of comma-separated 583 | #' string, otherwise fetch all strings 584 | #' @param first_arg_sep take first argument if multiple identifiers 585 | #' are in the node name, otherwise parse all identifiers 586 | #' @param sep separater to separate node names, defaul to space 587 | #' @param divide_semicolon whether to divide string by semicolon, 588 | #' and take the first value 589 | #' @param edge if converting edges 590 | #' @param remove_dot remove dots in the name 591 | #' @param file specify the file for conversion. 592 | #' The column in `query_column` will be used for querying the ID in the graph. 593 | #' @param query_column default to 1. 594 | #' @param pref prefix for the query identifiers 595 | #' @importFrom data.table fread 596 | #' @return vector containing converted IDs 597 | #' @export 598 | #' @examples 599 | #' library(tidygraph) 600 | #' graph <- create_test_pathway() 601 | #' graph <- graph %>% mutate(conv=convert_id("hsa")) 602 | #' 603 | convert_id <- function(org=NULL, name="name", file=NULL, query_column=1, 604 | convert_column=NULL, colon=TRUE, first_arg_comma=TRUE, remove_dot=TRUE, 605 | pref=NULL, sep=" ", first_arg_sep=TRUE, divide_semicolon=TRUE, edge=FALSE) { 606 | if (is.null(org) & is.null(file)) { 607 | stop("Please specify org or file") 608 | } 609 | graph <- .G() 610 | pid <- unique(V(graph)$pathway_id) 611 | if (edge) { 612 | x <- get.edge.attribute(graph, name) 613 | } else { 614 | x <- get.vertex.attribute(graph, name) 615 | } 616 | if (is.null(file)) { 617 | url <- paste0("https://rest.kegg.jp/list/",org) 618 | bfc <- BiocFileCache() 619 | path <- bfcrpath(bfc, url) 620 | convert <- fread(path, 621 | header=FALSE, 622 | sep="\t") %>% data.frame() 623 | } else { 624 | convert <- fread(file, 625 | header=FALSE, 626 | sep="\t") %>% data.frame() 627 | if (is.null(convert_column)) { 628 | stop("Please specify the column number for the file") 629 | } 630 | if (is.null(pref)) { 631 | pref <- "" 632 | } 633 | } 634 | 635 | 636 | if (is.null(convert_column)) { 637 | if (org=="ko") {pref <- "ko:";convert_column <- 2} 638 | else if (org=="compound") {pref <- "cpd:"; convert_column <- 2} 639 | else if (org=="glycan") {pref <- "gl:";convert_column <- 2} 640 | else if (org=="enzyme") {pref <- "ec:"; convert_column <- 2} 641 | else if (org=="reaction") {pref <- "rn:"; convert_column <- 2} 642 | else if (org=="pathway") { 643 | pref <- paste0("path:",gsub("[[:digit:]]","",pid)); 644 | convert_column <- 2 645 | if (is.null(pid)) {stop("please specify pathway id")} 646 | } 647 | else { 648 | pref <- "" 649 | convert_column <- 4 650 | } 651 | } 652 | convert_vec <- convert[,convert_column] 653 | if (is.null(org)) { 654 | names(convert_vec) <- 655 | paste0(pref,convert[, query_column]) 656 | } else { 657 | if (org=="pathway") { 658 | names(convert_vec) <- 659 | paste0(pref,str_extract(convert[, query_column], "[[:digit:]]+")) 660 | } else { 661 | names(convert_vec) <- 662 | paste0(pref,convert[, query_column]) 663 | } 664 | } 665 | if (!colon) { 666 | names(convert_vec) <- unlist( 667 | lapply(strsplit(names(convert_vec), ":"), "[", 2) 668 | ) 669 | } 670 | convs <- lapply(seq_along(x), function(xn) { 671 | if (grepl(sep,x[xn])) { 672 | spaced <- lapply(unlist(strsplit(x[xn], sep)), function (qu) { 673 | if (remove_dot) { 674 | qu <- strsplit(qu, "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 675 | } 676 | comma_test <- ifelse(first_arg_comma, 677 | strsplit(convert_vec[qu], ",")[[1]][1], 678 | paste0(convert_vec[qu])) 679 | sc_test <- ifelse(divide_semicolon, 680 | strsplit(comma_test, ";") |> 681 | vapply("[",1,FUN.VALUE="character"), 682 | comma_test) 683 | return(sc_test) 684 | }) |> unlist() 685 | spaced <- ifelse(first_arg_sep, spaced[1], 686 | paste(spaced, collapse=sep)) 687 | return(spaced) 688 | } else { 689 | if (remove_dot) { 690 | qu <- strsplit(x[xn], "\\.\\.\\.") %>% vapply("[", 1, FUN.VALUE="a") 691 | } else { 692 | qu <- x[xn] 693 | } 694 | comma_test <- ifelse(first_arg_comma, 695 | strsplit(convert_vec[qu], ",")[[1]][1], 696 | convert_vec[qu]) 697 | sc_test <- ifelse(divide_semicolon, 698 | strsplit(comma_test, ";") |> 699 | vapply("[",1,FUN.VALUE="character"), 700 | comma_test) 701 | return(sc_test) 702 | } 703 | }) 704 | convs |> unlist() 705 | } 706 | 707 | 708 | 709 | #' obtain_map_and_cache 710 | #' 711 | #' obtain list of genes, cache, and return the named vector for converting 712 | #' 713 | #' @import BiocFileCache 714 | #' @importFrom stringr str_extract str_extract_all str_pad str_locate_all 715 | #' @noRd 716 | obtain_map_and_cache <- function(org, pid=NULL, colon=TRUE) { 717 | url <- paste0("https://rest.kegg.jp/list/",org) 718 | bfc <- BiocFileCache() 719 | path <- bfcrpath(bfc, url) 720 | convert <- data.table::fread(path, 721 | header=FALSE, 722 | sep="\t") 723 | if (org %in% c("ko","compound")) {## KO and compound 724 | if (org=="compound") {pref <- "cpd"} 725 | else {pref <- "ko"} 726 | convert_vec <- vapply(convert$V2, function(x) { 727 | vapply(unlist(strsplit(x, ";"))[1], 728 | function(x) unlist(strsplit(x,","))[1], 729 | FUN.VALUE="character") 730 | }, FUN.VALUE="character") 731 | names(convert_vec) <- paste0(pref,":",convert$V1) 732 | } else if (org=="reaction") {## Reaction 733 | pref <- "rn:" 734 | convert_vec <- convert$V2 735 | names(convert_vec) <- paste0(pref,convert$V1) 736 | } else if (org=="pathway") {## Pathway 737 | pref <- paste0("path:",gsub("[[:digit:]]","",pid)) 738 | convert_vec <- convert$V2 739 | names(convert_vec) <- 740 | paste0(pref,str_extract(convert$V1, "[[:digit:]]+")) 741 | } else {## Ordinary organisms 742 | convert_vec <- vapply(convert$V4, function(x) { 743 | vapply(unlist(strsplit(x, ";"))[1], 744 | function(x) unlist(strsplit(x,","))[1], 745 | FUN.VALUE="character") 746 | }, FUN.VALUE="character") 747 | names(convert_vec) <- convert$V1 748 | } 749 | if (!colon) { 750 | names(convert_vec) <- unlist( 751 | lapply(strsplit(names(convert_vec), ":"), "[", 2) 752 | ) 753 | } 754 | convert_vec 755 | } 756 | 757 | #' carrow 758 | #' 759 | #' make closed type arrow 760 | #' @param length arrow length in unit() 761 | #' @export 762 | #' @examples 763 | #' carrow() 764 | #' @return arrow() 765 | #' 766 | carrow <- function(length=unit(2,"mm")) { 767 | arrow(length=length, type="closed") 768 | } 769 | 770 | #' combine_with_bnlearn 771 | #' 772 | #' combine the reference KEGG pathway graph 773 | #' with bnlearn boot.strength output 774 | #' 775 | #' @param pg reference graph (output of `pathway`) 776 | #' @param str strength data.frame 777 | #' @param av averaged network to plot 778 | #' @param prefix add prefix to node name of original averaged network 779 | #' like, `hsa:` or `ko:`. 780 | #' @param how `any` or `all` 781 | #' 782 | #' @return tbl_graph 783 | #' @importFrom tidygraph graph_join 784 | #' @export 785 | #' @examples 786 | #' if (requireNamespace("bnlearn", quietly=TRUE)) { 787 | #' ## Simulating boot.strength() results 788 | #' av <- bnlearn::model2network("[6737|51428][51428]") 789 | #' str <- data.frame(from="51428",to="6737",strength=0.8,direction=0.7) 790 | #' graph <- create_test_pathway() 791 | #' combined <- combine_with_bnlearn(graph, str, av, prefix="hsa:") 792 | #' } 793 | #' 794 | combine_with_bnlearn <- function(pg, str, av, prefix="ko:", how="any") { 795 | if (requireNamespace("bnlearn", quietly=TRUE)) { 796 | ## Make igraph with strength from bnlearn 797 | el <- av |> bnlearn::as.igraph() |> as_edgelist() |> data.frame() |> 798 | `colnames<-`(c("from","to")) 799 | g <- str |> merge(el) |> mutate(from=paste0(prefix,.data$from), 800 | to=paste0(prefix,.data$to)) |> 801 | data.frame() |> graph_from_data_frame() 802 | 803 | ## Merge node names with reference 804 | js <- lapply(V(pg)$name, function(i) { 805 | if (grepl(" ",i)) { 806 | ref_node <- strsplit(i, " ") |> unlist() 807 | ret <- lapply(V(g)$name, function(j) { 808 | if (how=="any") { 809 | if (length(intersect(ref_node, j))>0) { 810 | return(c(j, i)) 811 | } 812 | } else { 813 | if (length(intersect(ref_node, j))==length(ref_node)) { 814 | return(c(j, i)) 815 | } 816 | } 817 | }) 818 | return(do.call(rbind, ret)) 819 | } else { 820 | return(c(i, i)) 821 | } 822 | }) 823 | 824 | js <- do.call(rbind, js) |> 825 | data.frame() |> 826 | `colnames<-`(c("raw","reference")) 827 | gdf <- as_data_frame(g) 828 | 829 | new_df <- lapply(seq_len(nrow(gdf)), function(i) { 830 | if (gdf[i,"from"] %in% js$raw){ 831 | new_from <- js[js[,1]==gdf[i,"from"],]$reference 832 | return(c(new_from, gdf[i,"to"], 833 | gdf[i,"strength"], gdf[i,"direction"])) 834 | } else { 835 | stop("no `from` included in raw node name") 836 | } 837 | }) 838 | 839 | gdf <- do.call(rbind, new_df) |> 840 | data.frame() |> 841 | `colnames<-`(colnames(gdf)) 842 | 843 | new_df <- lapply(seq_len(nrow(gdf)), function(i) { 844 | if (gdf[i,"to"] %in% js$raw){ 845 | new_to <- js[js[,1]==gdf[i,"to"],]$reference 846 | new_df <- return(c(gdf[i,"from"], new_to, 847 | gdf[i,"strength"], gdf[i,"direction"])) 848 | } else { 849 | stop("no `to` included in raw node name") 850 | } 851 | }) 852 | gdf <- do.call(rbind, new_df) |> 853 | data.frame() |> 854 | `colnames<-`(colnames(gdf)) 855 | 856 | gdf$strength <- as.numeric(gdf$strength) 857 | gdf$direction <- as.numeric(gdf$direction) 858 | 859 | ## Drop duplicates 860 | gdf <- gdf |> 861 | distinct(.data$from, .data$to, .data$strength, .data$direction) 862 | 863 | joined <- graph_join(pg, gdf, by="name") 864 | joined 865 | } 866 | } -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r setup, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | fig.dev = "grDevices::png", 13 | dpi = 300L, 14 | dev.args = list(), 15 | fig.ext = "png", 16 | fig.height=8, 17 | fig.width=12, 18 | fig.retina = 2L, 19 | fig.align = "center" 20 | ) 21 | ``` 22 | 23 | # ggkegg 24 | 25 | 26 | [![R-CMD-check](https://github.com/noriakis/ggkegg/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/noriakis/ggkegg/actions/workflows/R-CMD-check.yaml) 27 | 28 | 29 | A set of functions to analyse and plot the KEGG information using `tidygraph`, `ggraph` and `ggplot2`. 30 | 31 | The detailed documentation is [here](https://noriakis.github.io/software/ggkegg) using `bookdown`. 32 | 33 | ## Installation 34 | 35 | Using `BiocManager`: 36 | 37 | ```{r, eval=FALSE} 38 | BiocManager::install("ggkegg") 39 | ``` 40 | 41 | Using `devtools`: 42 | 43 | ```{r, eval=FALSE} 44 | devtools::install_github("noriakis/ggkegg") 45 | ``` 46 | 47 | ## Examples 48 | 49 | ```{r message=FALSE, warning=FALSE, fig.width=8, fig.height=5} 50 | library(ggkegg) 51 | library(ggfx) 52 | library(igraph) 53 | library(tidygraph) 54 | library(dplyr) 55 | 56 | pathway("ko01100") |> 57 | process_line() |> 58 | highlight_module(module("M00021")) |> 59 | highlight_module(module("M00338")) |> 60 | ggraph(x=x, y=y) + 61 | geom_node_point(size=1, aes(color=I(fgcolor), 62 | filter=fgcolor!="none" & type!="line")) + 63 | geom_edge_link0(width=0.1, aes(color=I(fgcolor), 64 | filter=type=="line"& fgcolor!="none")) + 65 | with_outer_glow( 66 | geom_edge_link0(width=1, 67 | aes(color=I(fgcolor), 68 | filter=(M00021 | M00338))), 69 | colour="red", expand=5 70 | ) + 71 | with_outer_glow( 72 | geom_node_point(size=1.5, 73 | aes(color=I(fgcolor), 74 | filter=(M00021 | M00338))), 75 | colour="red", expand=5 76 | ) + 77 | geom_node_text(size=2, 78 | aes(x=x, y=y, 79 | label=graphics_name, 80 | filter=name=="path:ko00270"), 81 | repel=TRUE, family="sans", bg.colour="white") + 82 | theme_void() 83 | ``` 84 | 85 | You can use your favorite geoms to annotate raw KEGG map combining the functions. 86 | 87 | ```{r, message=FALSE, warning=FALSE, fig.width=8, fig.height=5} 88 | compounds <- c("cpd:C00100", "cpd:C00894", "cpd:C00894", "cpd:C05668", 89 | "cpd:C05668", "cpd:C01013", "cpd:C01013", "cpd:C00222", 90 | "cpd:C00222", "cpd:C00024") 91 | g <- pathway("ko00640") |> mutate(mod=highlight_set_nodes(compounds, how="all")) 92 | ggraph(g, layout="manual", x=x, y=y)+ 93 | geom_node_rect(fill="grey",aes(filter=type == "ortholog"))+ 94 | overlay_raw_map("ko00640")+ 95 | geom_node_point(aes(filter=type == "compound"), 96 | shape=21, fill="blue", color="black", size=2)+ 97 | ggfx::with_outer_glow( 98 | geom_node_point(aes(filter=mod, x=x, y=y), color="red",size=2), 99 | colour="yellow",expand=5 100 | )+ 101 | theme_void() 102 | ``` 103 | 104 | Or customize graphics based on `ggraph`. 105 | 106 | ```{r, message=FALSE, warning=FALSE} 107 | g <- pathway("hsa04110") 108 | pseudo_lfc <- sample(seq(0,3,0.1), length(V(g)), replace=TRUE) 109 | names(pseudo_lfc) <- V(g)$name 110 | 111 | ggkegg("hsa04110", 112 | convert_org = c("pathway","hsa","ko"), 113 | numeric_attribute = pseudo_lfc)+ 114 | geom_edge_parallel2( 115 | aes(color=subtype_name), 116 | arrow = arrow(length = unit(1, 'mm')), 117 | start_cap = square(1, 'cm'), 118 | end_cap = square(1.5, 'cm')) + 119 | geom_node_rect(aes(filter=.data$type == "group"), 120 | fill="transparent", color="red") + 121 | geom_node_rect(aes(fill=numeric_attribute, 122 | filter=.data$type == "gene")) + 123 | geom_node_text(aes(label=converted_name, 124 | filter=.data$type == "gene"), 125 | size=2.5, 126 | color="black") + 127 | with_outer_glow( 128 | geom_node_text(aes(label=converted_name, 129 | filter=converted_name=="PCNA"), 130 | size=2.5, color="red"), 131 | colour="white", expand=4 132 | ) + 133 | scale_edge_color_manual(values=viridis::plasma(11)) + 134 | scale_fill_viridis(name="LFC") + 135 | theme_void() 136 | ``` 137 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ggkegg 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/noriakis/ggkegg/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/noriakis/ggkegg/actions/workflows/R-CMD-check.yaml) 9 | 10 | 11 | A set of functions to analyse and plot the KEGG information using 12 | `tidygraph`, `ggraph` and `ggplot2`. 13 | 14 | The detailed documentation is 15 | [here](https://noriakis.github.io/software/ggkegg) using `bookdown`. 16 | 17 | ## Installation 18 | 19 | Using `BiocManager`: 20 | 21 | ``` r 22 | BiocManager::install("ggkegg") 23 | ``` 24 | 25 | Using `devtools`: 26 | 27 | ``` r 28 | devtools::install_github("noriakis/ggkegg") 29 | ``` 30 | 31 | ## Examples 32 | 33 | ``` r 34 | library(ggkegg) 35 | library(ggfx) 36 | library(igraph) 37 | library(tidygraph) 38 | library(dplyr) 39 | 40 | pathway("ko01100") |> 41 | process_line() |> 42 | highlight_module(module("M00021")) |> 43 | highlight_module(module("M00338")) |> 44 | ggraph(x=x, y=y) + 45 | geom_node_point(size=1, aes(color=I(fgcolor), 46 | filter=fgcolor!="none" & type!="line")) + 47 | geom_edge_link0(width=0.1, aes(color=I(fgcolor), 48 | filter=type=="line"& fgcolor!="none")) + 49 | with_outer_glow( 50 | geom_edge_link0(width=1, 51 | aes(color=I(fgcolor), 52 | filter=(M00021 | M00338))), 53 | colour="red", expand=5 54 | ) + 55 | with_outer_glow( 56 | geom_node_point(size=1.5, 57 | aes(color=I(fgcolor), 58 | filter=(M00021 | M00338))), 59 | colour="red", expand=5 60 | ) + 61 | geom_node_text(size=2, 62 | aes(x=x, y=y, 63 | label=graphics_name, 64 | filter=name=="path:ko00270"), 65 | repel=TRUE, family="sans", bg.colour="white") + 66 | theme_void() 67 | ``` 68 | 69 | 70 | 71 | You can use your favorite geoms to annotate raw KEGG map combining the 72 | functions. 73 | 74 | ``` r 75 | compounds <- c("cpd:C00100", "cpd:C00894", "cpd:C00894", "cpd:C05668", 76 | "cpd:C05668", "cpd:C01013", "cpd:C01013", "cpd:C00222", 77 | "cpd:C00222", "cpd:C00024") 78 | g <- pathway("ko00640") |> mutate(mod=highlight_set_nodes(compounds, how="all")) 79 | ggraph(g, layout="manual", x=x, y=y)+ 80 | geom_node_rect(fill="grey",aes(filter=type == "ortholog"))+ 81 | overlay_raw_map("ko00640")+ 82 | geom_node_point(aes(filter=type == "compound"), 83 | shape=21, fill="blue", color="black", size=2)+ 84 | ggfx::with_outer_glow( 85 | geom_node_point(aes(filter=mod, x=x, y=y), color="red",size=2), 86 | colour="yellow",expand=5 87 | )+ 88 | theme_void() 89 | ``` 90 | 91 | 92 | 93 | Or customize graphics based on `ggraph`. 94 | 95 | ``` r 96 | g <- pathway("hsa04110") 97 | pseudo_lfc <- sample(seq(0,3,0.1), length(V(g)), replace=TRUE) 98 | names(pseudo_lfc) <- V(g)$name 99 | 100 | ggkegg("hsa04110", 101 | convert_org = c("pathway","hsa","ko"), 102 | numeric_attribute = pseudo_lfc)+ 103 | geom_edge_parallel2( 104 | aes(color=subtype_name), 105 | arrow = arrow(length = unit(1, 'mm')), 106 | start_cap = square(1, 'cm'), 107 | end_cap = square(1.5, 'cm')) + 108 | geom_node_rect(aes(filter=.data$type == "group"), 109 | fill="transparent", color="red") + 110 | geom_node_rect(aes(fill=numeric_attribute, 111 | filter=.data$type == "gene")) + 112 | geom_node_text(aes(label=converted_name, 113 | filter=.data$type == "gene"), 114 | size=2.5, 115 | color="black") + 116 | with_outer_glow( 117 | geom_node_text(aes(label=converted_name, 118 | filter=converted_name=="PCNA"), 119 | size=2.5, color="red"), 120 | colour="white", expand=4 121 | ) + 122 | scale_edge_color_manual(values=viridis::plasma(11)) + 123 | scale_fill_viridis(name="LFC") + 124 | theme_void() 125 | ``` 126 | 127 | 128 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citEntry(entry ="ARTICLE", 2 | title = "ggkegg: analysis and visualization of KEGG data utilizing the grammar of graphics", 3 | author = personList( 4 | as.person("Noriaki Sato"), 5 | as.person("Miho Uematsu"), 6 | as.person("Kosuke Fujimoto"), 7 | as.person("Satoshi Uematsu"), 8 | as.person("Seiya Imoto") 9 | ), 10 | journal = "Bioinformatics", 11 | year = "2023", 12 | volume = "39", 13 | number = "10", 14 | pages = "btad622", 15 | PMID = "37846038", 16 | doi = "10.1093/bioinformatics/btad622", 17 | textVersion = paste("Sato N, Uematsu M, Fujimoto K, Uematsu S, Imoto S.", 18 | "ggkegg: analysis and visualization of KEGG data utilizing the grammar of graphics.", 19 | "Bioinformatics. 2023 Oct 3;39(10):btad622.") 20 | ) -------------------------------------------------------------------------------- /man/add_title.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlay_functions.R 3 | \name{add_title} 4 | \alias{add_title} 5 | \title{addTitle} 6 | \usage{ 7 | add_title( 8 | out, 9 | title = NULL, 10 | size = 20, 11 | height = 30, 12 | color = "white", 13 | titleColor = "black", 14 | gravity = "west" 15 | ) 16 | } 17 | \arguments{ 18 | \item{out}{the image} 19 | 20 | \item{title}{the title} 21 | 22 | \item{size}{the size} 23 | 24 | \item{height}{title height} 25 | 26 | \item{color}{bg color} 27 | 28 | \item{titleColor}{title color} 29 | 30 | \item{gravity}{positioning of the title in the blank image} 31 | } 32 | \value{ 33 | output the image 34 | } 35 | \description{ 36 | Add the title to the image produced by output_overlay_image 37 | using magick. 38 | } 39 | -------------------------------------------------------------------------------- /man/append_cp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{append_cp} 4 | \alias{append_cp} 5 | \title{append_cp} 6 | \usage{ 7 | append_cp( 8 | res, 9 | how = "any", 10 | name = "name", 11 | pid = NULL, 12 | infer = FALSE, 13 | sep = " ", 14 | remove_dot = TRUE 15 | ) 16 | } 17 | \arguments{ 18 | \item{res}{enrichResult class} 19 | 20 | \item{how}{how to determine whether the nodes is in enrichment results} 21 | 22 | \item{name}{name column to search for query} 23 | 24 | \item{pid}{pathway ID, if NULL, try to infer from graph attribute} 25 | 26 | \item{infer}{if TRUE, append the prefix to queried IDs based on pathway ID} 27 | 28 | \item{sep}{separater for name} 29 | 30 | \item{remove_dot}{remove dots in the name} 31 | } 32 | \value{ 33 | enrich_attribute column in node 34 | } 35 | \description{ 36 | append clusterProfiler results to graph 37 | } 38 | \examples{ 39 | graph <- create_test_pathway() 40 | nodes <- graph |> data.frame() 41 | if (require("clusterProfiler")) { 42 | cp <- enrichKEGG(nodes$name |> 43 | strsplit(":") |> 44 | vapply("[", 2, FUN.VALUE="character")) 45 | ## This append graph node logical value whether the 46 | ## enriched genes are in pathway 47 | graph <- graph |> mutate(cp=append_cp(cp, pid="hsa05322")) 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /man/append_label_position.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{append_label_position} 4 | \alias{append_label_position} 5 | \title{append_label_position} 6 | \usage{ 7 | append_label_position(g) 8 | } 9 | \arguments{ 10 | \item{g}{graph} 11 | } 12 | \value{ 13 | tbl_graph 14 | } 15 | \description{ 16 | Append the label position at center of edges 17 | in global map like ko01100 where line type nodes 18 | are present in KGML. 19 | Add `center` column to graph edge. 20 | } 21 | \examples{ 22 | ## Simulate nodes containing `graphics_type` of line and `coords` 23 | gm_test <- data.frame(name="ko:K00112",type="ortholog",reaction="rn:R00112", 24 | graphics_name="K00112",fgcolor="#ff0000",bgcolor="#ffffff", 25 | graphics_type="line",coords="1,2,3,4",orig.id=1,pathway_id="test") 26 | gm_test <- tbl_graph(gm_test) 27 | test <- process_line(gm_test) |> append_label_position() 28 | } 29 | -------------------------------------------------------------------------------- /man/assign_deseq2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{assign_deseq2} 4 | \alias{assign_deseq2} 5 | \title{assign_deseq2} 6 | \usage{ 7 | assign_deseq2( 8 | res, 9 | column = "log2FoldChange", 10 | gene_type = "SYMBOL", 11 | org_db = NULL, 12 | org = "hsa", 13 | numeric_combine = mean, 14 | name = "name", 15 | sep = " ", 16 | remove_dot = TRUE 17 | ) 18 | } 19 | \arguments{ 20 | \item{res}{The result() of DESeq()} 21 | 22 | \item{column}{column of the numeric attribute, default to log2FoldChange} 23 | 24 | \item{gene_type}{default to SYMBOL} 25 | 26 | \item{org_db}{organism database to convert ID to ENTREZID} 27 | 28 | \item{org}{organism ID in KEGG} 29 | 30 | \item{numeric_combine}{how to combine multiple numeric values} 31 | 32 | \item{name}{column name for ID in tbl_graph nodes} 33 | 34 | \item{sep}{for node name} 35 | 36 | \item{remove_dot}{remove dot in the name} 37 | } 38 | \value{ 39 | numeric vector 40 | } 41 | \description{ 42 | assign DESeq2 numerical values to nodes 43 | } 44 | \examples{ 45 | graph <- create_test_pathway() 46 | res <- data.frame(row.names="6737",log2FoldChange=1.2) 47 | graph <- graph |> mutate(num=assign_deseq2(res, gene_type="ENTREZID")) 48 | } 49 | -------------------------------------------------------------------------------- /man/carrow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{carrow} 4 | \alias{carrow} 5 | \title{carrow} 6 | \usage{ 7 | carrow(length = unit(2, "mm")) 8 | } 9 | \arguments{ 10 | \item{length}{arrow length in unit()} 11 | } 12 | \value{ 13 | arrow() 14 | } 15 | \description{ 16 | make closed type arrow 17 | } 18 | \examples{ 19 | carrow() 20 | } 21 | -------------------------------------------------------------------------------- /man/combine_with_bnlearn.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{combine_with_bnlearn} 4 | \alias{combine_with_bnlearn} 5 | \title{combine_with_bnlearn} 6 | \usage{ 7 | combine_with_bnlearn(pg, str, av, prefix = "ko:", how = "any") 8 | } 9 | \arguments{ 10 | \item{pg}{reference graph (output of `pathway`)} 11 | 12 | \item{str}{strength data.frame} 13 | 14 | \item{av}{averaged network to plot} 15 | 16 | \item{prefix}{add prefix to node name of original averaged network 17 | like, `hsa:` or `ko:`.} 18 | 19 | \item{how}{`any` or `all`} 20 | } 21 | \value{ 22 | tbl_graph 23 | } 24 | \description{ 25 | combine the reference KEGG pathway graph 26 | with bnlearn boot.strength output 27 | } 28 | \examples{ 29 | if (requireNamespace("bnlearn", quietly=TRUE)) { 30 | ## Simulating boot.strength() results 31 | av <- bnlearn::model2network("[6737|51428][51428]") 32 | str <- data.frame(from="51428",to="6737",strength=0.8,direction=0.7) 33 | graph <- create_test_pathway() 34 | combined <- combine_with_bnlearn(graph, str, av, prefix="hsa:") 35 | } 36 | 37 | } 38 | -------------------------------------------------------------------------------- /man/convert_id.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{convert_id} 4 | \alias{convert_id} 5 | \title{convert_id} 6 | \usage{ 7 | convert_id( 8 | org = NULL, 9 | name = "name", 10 | file = NULL, 11 | query_column = 1, 12 | convert_column = NULL, 13 | colon = TRUE, 14 | first_arg_comma = TRUE, 15 | remove_dot = TRUE, 16 | pref = NULL, 17 | sep = " ", 18 | first_arg_sep = TRUE, 19 | divide_semicolon = TRUE, 20 | edge = FALSE 21 | ) 22 | } 23 | \arguments{ 24 | \item{org}{which identifier to convert} 25 | 26 | \item{name}{which column to convert in edge or node table} 27 | 28 | \item{file}{specify the file for conversion. 29 | The column in `query_column` will be used for querying the ID in the graph.} 30 | 31 | \item{query_column}{default to 1.} 32 | 33 | \item{convert_column}{which column is parsed in 34 | obtained data frame from KEGG REST API or local file} 35 | 36 | \item{colon}{whether the original ids include colon (e.g. `ko:`) 37 | If `NULL`, automatically set according to `org`} 38 | 39 | \item{first_arg_comma}{take first argument of comma-separated 40 | string, otherwise fetch all strings} 41 | 42 | \item{remove_dot}{remove dots in the name} 43 | 44 | \item{pref}{prefix for the query identifiers} 45 | 46 | \item{sep}{separater to separate node names, defaul to space} 47 | 48 | \item{first_arg_sep}{take first argument if multiple identifiers 49 | are in the node name, otherwise parse all identifiers} 50 | 51 | \item{divide_semicolon}{whether to divide string by semicolon, 52 | and take the first value} 53 | 54 | \item{edge}{if converting edges} 55 | } 56 | \value{ 57 | vector containing converted IDs 58 | } 59 | \description{ 60 | convert the identifier using retrieved information 61 | } 62 | \examples{ 63 | library(tidygraph) 64 | graph <- create_test_pathway() 65 | graph <- graph \%>\% mutate(conv=convert_id("hsa")) 66 | 67 | } 68 | -------------------------------------------------------------------------------- /man/create_test_module.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{create_test_module} 4 | \alias{create_test_module} 5 | \title{create_test_module} 6 | \usage{ 7 | create_test_module() 8 | } 9 | \value{ 10 | return a test module to use in examples 11 | } 12 | \description{ 13 | Test kegg_module for examples and vignettes. 14 | The module has no biological meanings. 15 | } 16 | \examples{ 17 | create_test_module() 18 | } 19 | -------------------------------------------------------------------------------- /man/create_test_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/network_functions.R 3 | \name{create_test_network} 4 | \alias{create_test_network} 5 | \title{create_test_network} 6 | \usage{ 7 | create_test_network() 8 | } 9 | \value{ 10 | test network 11 | } 12 | \description{ 13 | create_test_network 14 | } 15 | \examples{ 16 | create_test_network() 17 | } 18 | -------------------------------------------------------------------------------- /man/create_test_pathway.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pathway_functions.R 3 | \name{create_test_pathway} 4 | \alias{create_test_pathway} 5 | \title{create_test_pathway} 6 | \usage{ 7 | create_test_pathway(line = FALSE) 8 | } 9 | \arguments{ 10 | \item{line}{return example containing graphics type line} 11 | } 12 | \value{ 13 | tbl_graph 14 | } 15 | \description{ 16 | As downloading from KEGG API is not desirable 17 | in vignettes or examples, return the `tbl_graph` 18 | with two nodes and two edges. 19 | } 20 | \examples{ 21 | create_test_pathway() 22 | } 23 | -------------------------------------------------------------------------------- /man/edge_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{edge_matrix} 4 | \alias{edge_matrix} 5 | \title{edge_matrix} 6 | \usage{ 7 | edge_matrix( 8 | graph, 9 | mat, 10 | gene_type = "SYMBOL", 11 | org = "hsa", 12 | org_db = NULL, 13 | num_combine = mean, 14 | name = "name", 15 | sep = " ", 16 | remove_dot = TRUE 17 | ) 18 | } 19 | \arguments{ 20 | \item{graph}{tbl_graph to append values to} 21 | 22 | \item{mat}{matrix representing gene as row and sample as column} 23 | 24 | \item{gene_type}{gene ID of matrix row} 25 | 26 | \item{org}{organism ID to convert ID} 27 | 28 | \item{org_db}{organism database to convert ID} 29 | 30 | \item{num_combine}{function to combine multiple numeric values} 31 | 32 | \item{name}{name column in node data, default to node} 33 | 34 | \item{sep}{separater of name, default to " "} 35 | 36 | \item{remove_dot}{remove "..." in node name} 37 | } 38 | \value{ 39 | tbl_graph 40 | } 41 | \description{ 42 | given the matrix representing gene as row and sample as column, 43 | append the edge value (sum of values of connecting nodes) to edge matrix and 44 | return tbl_graph object. The implementation is based on the paper by 45 | Adnan et al. 2020 (https://doi.org/10.1186/s12859-020-03692-2). 46 | } 47 | \examples{ 48 | graph <- create_test_pathway() 49 | num_df <- data.frame(row.names=c("6737","51428"), 50 | "sample1"=c(1.1,1.2), 51 | "sample2"=c(1.1,1.2), 52 | check.names=FALSE) 53 | graph <- graph \%>\% edge_matrix(num_df, gene_type="ENTREZID") 54 | } 55 | -------------------------------------------------------------------------------- /man/edge_numeric.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{edge_numeric} 4 | \alias{edge_numeric} 5 | \title{edge_numeric} 6 | \usage{ 7 | edge_numeric( 8 | num, 9 | num_combine = mean, 10 | how = "any", 11 | name = "name", 12 | sep = " ", 13 | remove_dot = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{num}{named vector or tibble with id and value column} 18 | 19 | \item{num_combine}{how to combine number when multiple hit in the same node} 20 | 21 | \item{how}{`any` or `all`} 22 | 23 | \item{name}{name of column to match for} 24 | 25 | \item{sep}{separater for name, default to " "} 26 | 27 | \item{remove_dot}{remove "..." in the name} 28 | } 29 | \value{ 30 | numeric vector 31 | } 32 | \description{ 33 | add numeric attribute to edge of tbl_graph 34 | } 35 | \examples{ 36 | graph <- create_test_pathway() 37 | graph <- graph |> activate("edges") |> 38 | mutate(num=edge_numeric(c(1.1) |> 39 | setNames("degradation"), name="subtype_name")) 40 | } 41 | -------------------------------------------------------------------------------- /man/edge_numeric_sum.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{edge_numeric_sum} 4 | \alias{edge_numeric_sum} 5 | \title{edge_numeric_sum} 6 | \usage{ 7 | edge_numeric_sum( 8 | num, 9 | num_combine = mean, 10 | how = "any", 11 | name = "name", 12 | sep = " ", 13 | remove_dot = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{num}{named vector or tibble with id and value column} 18 | 19 | \item{num_combine}{how to combine number when multiple hit in the same node} 20 | 21 | \item{how}{`any` or `all`} 22 | 23 | \item{name}{name of column to match for} 24 | 25 | \item{sep}{separater for name, default to " "} 26 | 27 | \item{remove_dot}{remove "..." in the name} 28 | } 29 | \value{ 30 | numeric vector 31 | } 32 | \description{ 33 | add numeric attribute to edge of tbl_graph based on node values 34 | The implementation is based on the paper by 35 | Adnan et al. 2020 (https://doi.org/10.1186/s12859-020-03692-2). 36 | } 37 | \examples{ 38 | graph <- create_test_pathway() 39 | graph <- graph |> 40 | activate("edges") |> 41 | mutate(num=edge_numeric_sum(c(1.2,-1.2) |> 42 | setNames(c("TRIM21","DDX41")), name="graphics_name")) 43 | } 44 | -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/noriakis/ggkegg/a9e00aa875a2b8bd46630f505274e8c4f24560cf/man/figures/README-unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/noriakis/ggkegg/a9e00aa875a2b8bd46630f505274e8c4f24560cf/man/figures/README-unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/noriakis/ggkegg/a9e00aa875a2b8bd46630f505274e8c4f24560cf/man/figures/README-unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /man/geom_kegg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{geom_kegg} 4 | \alias{geom_kegg} 5 | \title{geom_kegg} 6 | \usage{ 7 | geom_kegg( 8 | edge_color = NULL, 9 | node_label = .data$name, 10 | group_color = "red", 11 | parallel = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{edge_color}{color attribute to edge} 16 | 17 | \item{node_label}{column name for node label} 18 | 19 | \item{group_color}{border color for group node rectangles} 20 | 21 | \item{parallel}{use geom_edge_parallel() instead of geom_edge_link()} 22 | } 23 | \value{ 24 | ggplot2 object 25 | } 26 | \description{ 27 | Wrapper function for plotting KEGG pathway graph 28 | add geom_node_rect, geom_node_text and geom_edge_link simultaneously 29 | } 30 | \examples{ 31 | test_pathway <- create_test_pathway() 32 | p <- ggraph(test_pathway, layout="manual", x=x, y=y)+ 33 | geom_kegg() 34 | } 35 | -------------------------------------------------------------------------------- /man/geom_node_rect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{geom_node_rect} 4 | \alias{geom_node_rect} 5 | \title{geom_node_rect} 6 | \usage{ 7 | geom_node_rect( 8 | mapping = NULL, 9 | data = NULL, 10 | position = "identity", 11 | show.legend = NA, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{mapping}{aes mapping} 17 | 18 | \item{data}{data to plot} 19 | 20 | \item{position}{positional argument} 21 | 22 | \item{show.legend}{whether to show legend} 23 | 24 | \item{...}{passed to `params` in `layer()` function} 25 | } 26 | \value{ 27 | geom 28 | } 29 | \description{ 30 | Plot rectangular shapes to ggplot2 using GeomRect, 31 | using StatFilter in ggraph 32 | } 33 | \examples{ 34 | test_pathway <- create_test_pathway() 35 | plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 36 | geom_node_rect() 37 | } 38 | -------------------------------------------------------------------------------- /man/geom_node_rect_kegg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{geom_node_rect_kegg} 4 | \alias{geom_node_rect_kegg} 5 | \title{geom_node_rect_kegg} 6 | \usage{ 7 | geom_node_rect_kegg(type = NULL, rect_fill = "grey") 8 | } 9 | \arguments{ 10 | \item{type}{type to be plotted (gene, map, compound ...)} 11 | 12 | \item{rect_fill}{rectangular fill} 13 | } 14 | \value{ 15 | ggplot2 object 16 | } 17 | \description{ 18 | Wrapper function for plotting a certain type of nodes 19 | with background color with geom_node_rect() 20 | } 21 | \examples{ 22 | test_pathway <- create_test_pathway() 23 | plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 24 | geom_node_rect_kegg(type="gene") 25 | } 26 | -------------------------------------------------------------------------------- /man/geom_node_rect_multi.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{geom_node_rect_multi} 4 | \alias{geom_node_rect_multi} 5 | \title{geom_node_rect_multi} 6 | \usage{ 7 | geom_node_rect_multi(..., asIs = TRUE) 8 | } 9 | \arguments{ 10 | \item{...}{color columns} 11 | 12 | \item{asIs}{treat the color as is or not} 13 | } 14 | \value{ 15 | ggplot2 object 16 | } 17 | \description{ 18 | Wrapper function for plotting multiple rects 19 | with background color with geom_node_rect(). 20 | All columns should belong to the same scale when 21 | using `asIs=FALSE`. If you need multiple scales for 22 | each element, please use `ggh4x::scale_fill_multi` 23 | for each. 24 | } 25 | \examples{ 26 | plt <- create_test_pathway() \%>\% ggraph() + geom_node_rect_multi(bgcolor) 27 | } 28 | -------------------------------------------------------------------------------- /man/geom_node_shadowtext.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{geom_node_shadowtext} 4 | \alias{geom_node_shadowtext} 5 | \title{geom_node_shadowtext} 6 | \usage{ 7 | geom_node_shadowtext( 8 | mapping = NULL, 9 | data = NULL, 10 | position = "identity", 11 | show.legend = NA, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{mapping}{aes mapping} 17 | 18 | \item{data}{data to plot} 19 | 20 | \item{position}{positional argument} 21 | 22 | \item{show.legend}{whether to show legend} 23 | 24 | \item{...}{passed to `params` in `layer()` function} 25 | } 26 | \value{ 27 | geom 28 | } 29 | \description{ 30 | Plot shadowtext at node position, use StatFilter in ggraph 31 | } 32 | \examples{ 33 | test_pathway <- create_test_pathway() 34 | plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 35 | geom_node_shadowtext(aes(label=name)) 36 | } 37 | -------------------------------------------------------------------------------- /man/get_module_attribute-kegg_module-method.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{get_module_attribute,kegg_module-method} 4 | \alias{get_module_attribute,kegg_module-method} 5 | \title{get_module_attribute} 6 | \usage{ 7 | \S4method{get_module_attribute}{kegg_module}(x, attribute) 8 | } 9 | \arguments{ 10 | \item{x}{kegg_module class object} 11 | 12 | \item{attribute}{slot name} 13 | } 14 | \value{ 15 | attribute of kegg_module 16 | } 17 | \description{ 18 | get the kegg_module class attribute 19 | } 20 | -------------------------------------------------------------------------------- /man/get_module_attribute.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{get_module_attribute} 4 | \alias{get_module_attribute} 5 | \title{get_module_attribute} 6 | \usage{ 7 | get_module_attribute(x, attribute) 8 | } 9 | \arguments{ 10 | \item{x}{kegg_module class object} 11 | 12 | \item{attribute}{pass to get_module_attribute} 13 | } 14 | \value{ 15 | attribute of kegg_module 16 | } 17 | \description{ 18 | Get slot from `kegg_module` class object. 19 | } 20 | \details{ 21 | Get slot from `kegg_module` class object. 22 | } 23 | -------------------------------------------------------------------------------- /man/get_network_attribute-kegg_network-method.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/network_functions.R 3 | \name{get_network_attribute,kegg_network-method} 4 | \alias{get_network_attribute,kegg_network-method} 5 | \title{get_network_attribute} 6 | \usage{ 7 | \S4method{get_network_attribute}{kegg_network}(x, attribute) 8 | } 9 | \arguments{ 10 | \item{x}{kegg_network class object} 11 | 12 | \item{attribute}{slot name} 13 | } 14 | \value{ 15 | attribute of kegg_module 16 | } 17 | \description{ 18 | get the kegg_network class attribute 19 | } 20 | -------------------------------------------------------------------------------- /man/get_network_attribute.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/network_functions.R 3 | \name{get_network_attribute} 4 | \alias{get_network_attribute} 5 | \title{get_network_attribute} 6 | \usage{ 7 | get_network_attribute(x, attribute) 8 | } 9 | \arguments{ 10 | \item{x}{kegg_network class object} 11 | 12 | \item{attribute}{pass to get_network_attribute} 13 | } 14 | \value{ 15 | attribute of kegg_network 16 | } 17 | \description{ 18 | get slot from `kegg_network` class 19 | } 20 | -------------------------------------------------------------------------------- /man/ggkegg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggkegg.R 3 | \name{ggkegg} 4 | \alias{ggkegg} 5 | \title{ggkegg} 6 | \usage{ 7 | ggkegg( 8 | pid, 9 | layout = "native", 10 | return_igraph = FALSE, 11 | return_tbl_graph = FALSE, 12 | pathway_number = 1, 13 | convert_org = NULL, 14 | convert_first = TRUE, 15 | convert_collapse = NULL, 16 | convert_reaction = FALSE, 17 | delete_undefined = FALSE, 18 | delete_zero_degree = FALSE, 19 | numeric_attribute = NULL, 20 | node_rect_nudge = 0, 21 | group_rect_nudge = 2, 22 | module_type = "definition", 23 | module_definition_type = "text" 24 | ) 25 | } 26 | \arguments{ 27 | \item{pid}{KEGG Pathway id e.g. hsa04110} 28 | 29 | \item{layout}{default to "native", using KGML positions} 30 | 31 | \item{return_igraph}{return the resulting igraph object} 32 | 33 | \item{return_tbl_graph}{return the resulting tbl_graph object 34 | (override `return_igraph` argument)} 35 | 36 | \item{pathway_number}{pathway number if passing enrichResult} 37 | 38 | \item{convert_org}{these organism names are fetched from REST API 39 | and cached, and used to convert the KEGG identifiers. 40 | e.g. c("hsa", "compound")} 41 | 42 | \item{convert_first}{after converting, take the first element as 43 | node name when multiple genes are listed in the node} 44 | 45 | \item{convert_collapse}{if not NULL, collapse 46 | the gene names by this character 47 | when multiple genes are listed in the node.} 48 | 49 | \item{convert_reaction}{reaction name (graph attribute `reaction`) 50 | will be converted to reaction formula} 51 | 52 | \item{delete_undefined}{delete `undefined` node specifying group, 53 | should be set to `TRUE` when the layout is not from native KGML.} 54 | 55 | \item{delete_zero_degree}{delete nodes with zero degree, 56 | default to FALSE} 57 | 58 | \item{numeric_attribute}{named vector for appending numeric attribute} 59 | 60 | \item{node_rect_nudge}{parameter for nudging the node rect} 61 | 62 | \item{group_rect_nudge}{parameter for nudging the group node rect} 63 | 64 | \item{module_type}{specify which module attributes to obtain 65 | (definition or reaction)} 66 | 67 | \item{module_definition_type}{`text` or `network` 68 | when parsing module definition. 69 | If `text`, return ggplot object. If `network`, return `tbl_graph`.} 70 | } 71 | \value{ 72 | ggplot2 object 73 | } 74 | \description{ 75 | main function parsing KEGG pathway data, 76 | making igraph object and passing it to ggraph. 77 | } 78 | \examples{ 79 | ## Use pathway ID to obtain `ggraph` object directly. 80 | g <- ggkegg("hsa04110") 81 | g + geom_node_rect() 82 | } 83 | -------------------------------------------------------------------------------- /man/ggkeggsave.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlay_functions.R 3 | \name{ggkeggsave} 4 | \alias{ggkeggsave} 5 | \title{ggkeggsave} 6 | \usage{ 7 | ggkeggsave(filename, plot, dpi = 300, wscale = 90, hscale = 90) 8 | } 9 | \arguments{ 10 | \item{filename}{file name of the image} 11 | 12 | \item{plot}{plot to be saved} 13 | 14 | \item{dpi}{dpi, passed to ggsave} 15 | 16 | \item{wscale}{width scaling factor for pixel to inches} 17 | 18 | \item{hscale}{height scaling factor fo pixel to inches} 19 | } 20 | \value{ 21 | save the image 22 | } 23 | \description{ 24 | save the image respecting the original width and height of the image. 25 | Only applicable for the ggplot object including `overlay_raw_map` layers. 26 | } 27 | -------------------------------------------------------------------------------- /man/ggplot_add.geom_kegg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{ggplot_add.geom_kegg} 4 | \alias{ggplot_add.geom_kegg} 5 | \title{ggplot_add.geom_kegg} 6 | \usage{ 7 | \method{ggplot_add}{geom_kegg}(object, plot, object_name) 8 | } 9 | \arguments{ 10 | \item{object}{An object to add to the plot} 11 | 12 | \item{plot}{The ggplot object to add object to} 13 | 14 | \item{object_name}{The name of the object to add} 15 | } 16 | \value{ 17 | ggplot2 object 18 | } 19 | \description{ 20 | ggplot_add.geom_kegg 21 | } 22 | \examples{ 23 | test_pathway <- create_test_pathway() 24 | p <- ggraph(test_pathway, layout="manual", x=x, y=y)+ 25 | geom_kegg() 26 | } 27 | -------------------------------------------------------------------------------- /man/ggplot_add.geom_node_rect_kegg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{ggplot_add.geom_node_rect_kegg} 4 | \alias{ggplot_add.geom_node_rect_kegg} 5 | \title{ggplot_add.geom_node_rect_kegg} 6 | \usage{ 7 | \method{ggplot_add}{geom_node_rect_kegg}(object, plot, object_name) 8 | } 9 | \arguments{ 10 | \item{object}{An object to add to the plot} 11 | 12 | \item{plot}{The ggplot object to add object to} 13 | 14 | \item{object_name}{The name of the object to add} 15 | } 16 | \value{ 17 | ggplot2 object 18 | } 19 | \description{ 20 | ggplot_add.geom_node_rect_kegg 21 | } 22 | \examples{ 23 | test_pathway <- create_test_pathway() 24 | plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 25 | geom_node_rect_kegg(type="gene") 26 | } 27 | -------------------------------------------------------------------------------- /man/ggplot_add.geom_node_rect_multi.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{ggplot_add.geom_node_rect_multi} 4 | \alias{ggplot_add.geom_node_rect_multi} 5 | \title{ggplot_add.geom_node_rect_multi} 6 | \usage{ 7 | \method{ggplot_add}{geom_node_rect_multi}(object, plot, object_name) 8 | } 9 | \arguments{ 10 | \item{object}{An object to add to the plot} 11 | 12 | \item{plot}{The ggplot object to add object to} 13 | 14 | \item{object_name}{The name of the object to add} 15 | } 16 | \value{ 17 | ggplot2 object 18 | } 19 | \description{ 20 | ggplot_add.geom_node_rect_multi 21 | } 22 | \examples{ 23 | plt <- create_test_pathway() \%>\% ggraph() + geom_node_rect_multi(bgcolor) 24 | } 25 | -------------------------------------------------------------------------------- /man/ggplot_add.overlay_raw_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlay_functions.R 3 | \name{ggplot_add.overlay_raw_map} 4 | \alias{ggplot_add.overlay_raw_map} 5 | \title{ggplot_add.overlay_raw_map} 6 | \usage{ 7 | \method{ggplot_add}{overlay_raw_map}(object, plot, object_name) 8 | } 9 | \arguments{ 10 | \item{object}{An object to add to the plot} 11 | 12 | \item{plot}{The ggplot object to add object to} 13 | 14 | \item{object_name}{The name of the object to add} 15 | } 16 | \value{ 17 | ggplot2 object 18 | } 19 | \description{ 20 | ggplot_add.overlay_raw_map 21 | } 22 | \examples{ 23 | ## Need `pathway_id` column in graph 24 | ## if the function is to automatically infer 25 | graph <- create_test_pathway() |> mutate(pathway_id="hsa04110") 26 | ggraph(graph) + overlay_raw_map() 27 | 28 | } 29 | -------------------------------------------------------------------------------- /man/ggplot_add.stamp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stamp.R 3 | \name{ggplot_add.stamp} 4 | \alias{ggplot_add.stamp} 5 | \title{ggplot_add.stamp} 6 | \usage{ 7 | \method{ggplot_add}{stamp}(object, plot, object_name) 8 | } 9 | \arguments{ 10 | \item{object}{An object to add to the plot} 11 | 12 | \item{plot}{The ggplot object to add object to} 13 | 14 | \item{object_name}{The name of the object to add} 15 | } 16 | \value{ 17 | ggplot2 object 18 | } 19 | \description{ 20 | ggplot_add.stamp 21 | } 22 | \examples{ 23 | test_pathway <- create_test_pathway() 24 | plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 25 | stamp("hsa:6737") 26 | } 27 | -------------------------------------------------------------------------------- /man/highlight_entities.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/highlight_functions.R 3 | \name{highlight_entities} 4 | \alias{highlight_entities} 5 | \title{highlight_entities} 6 | \usage{ 7 | highlight_entities( 8 | pathway, 9 | set, 10 | how = "any", 11 | num_combine = mean, 12 | name = "graphics_name", 13 | sep = ", ", 14 | no_sep = FALSE, 15 | show_type = "gene", 16 | fill_color = "tomato", 17 | remove_dot = TRUE, 18 | legend_name = NULL, 19 | use_cache = FALSE, 20 | return_graph = FALSE, 21 | directory = NULL 22 | ) 23 | } 24 | \arguments{ 25 | \item{pathway}{pathway ID to be passed to `pathway()`} 26 | 27 | \item{set}{vector of identifiers, or named vector of numeric values} 28 | 29 | \item{how}{if `all`, if node contains multiple 30 | IDs separated by `sep`, highlight if all the IDs 31 | are in query. if `any`, highlight if one of the IDs 32 | is in query.} 33 | 34 | \item{num_combine}{combining function if multiple hits are obtained per node} 35 | 36 | \item{name}{which column to search for} 37 | 38 | \item{sep}{separater for node names} 39 | 40 | \item{no_sep}{not separate node name} 41 | 42 | \item{show_type}{entitie type, default to 'gene'} 43 | 44 | \item{fill_color}{highlight color, default to 'tomato'} 45 | 46 | \item{remove_dot}{remove the "..." in the graphics name column} 47 | 48 | \item{legend_name}{legend name, NULL to suppress} 49 | 50 | \item{use_cache}{use cache or not} 51 | 52 | \item{return_graph}{return tbl_graph instead of plot} 53 | 54 | \item{directory}{directroy with XML files. ignore caching when specified.} 55 | } 56 | \value{ 57 | overlaid map 58 | } 59 | \description{ 60 | highlight the entities in the pathway, 61 | overlay raw map and return the results. 62 | Note that highlighted nodes are considered to be rectangular, 63 | so it is not compatible with the type like `compound`. 64 | } 65 | \examples{ 66 | highlight_entities("hsa04110", c("CDKN2A"), legend_name="interesting") 67 | } 68 | -------------------------------------------------------------------------------- /man/highlight_module.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/highlight_functions.R 3 | \name{highlight_module} 4 | \alias{highlight_module} 5 | \title{highlight_module} 6 | \usage{ 7 | highlight_module(graph, kmo, name = "name", sep = " ", verbose = FALSE) 8 | } 9 | \arguments{ 10 | \item{graph}{tbl_graph} 11 | 12 | \item{kmo}{kegg_module class object which stores reaction} 13 | 14 | \item{name}{which column to search for} 15 | 16 | \item{sep}{separator for node names} 17 | 18 | \item{verbose}{show messages or not} 19 | } 20 | \value{ 21 | boolean vector 22 | } 23 | \description{ 24 | identify if edges are involved in module reaction, and whether 25 | linked compounds are involved in the reaction. It would not be exactly 26 | the same as KEGG mapper. For instance, `R04293` involved in `M00912` 27 | is not included in KGML of `ko01100`. 28 | } 29 | \examples{ 30 | ## Highlight module within the pathway 31 | graph <- create_test_pathway() 32 | mo <- create_test_module() 33 | graph <- graph |> highlight_module(mo) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/highlight_set_edges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/highlight_functions.R 3 | \name{highlight_set_edges} 4 | \alias{highlight_set_edges} 5 | \title{highlight_set_edges} 6 | \usage{ 7 | highlight_set_edges(set, how = "all", name = "name", sep = " ", no_sep = FALSE) 8 | } 9 | \arguments{ 10 | \item{set}{set of identifiers} 11 | 12 | \item{how}{if `all`, if node contains multiple 13 | IDs separated by `sep`, highlight if all the IDs 14 | are in query. if `any`, highlight if one of the IDs 15 | is in query.} 16 | 17 | \item{name}{which column to search for} 18 | 19 | \item{sep}{separater for node names} 20 | 21 | \item{no_sep}{not separate node name} 22 | } 23 | \value{ 24 | boolean vector 25 | } 26 | \description{ 27 | identify if edges are involved in specific query. 28 | if multiple IDs are listed after separation by `sep`, 29 | only return TRUE if all the IDs are in the query. 30 | } 31 | \examples{ 32 | graph <- create_test_pathway() 33 | 34 | ## Specify edge column by `name` 35 | ## In this example, edges having `degradation` value in 36 | ## `subtype_name` column will be highlighted 37 | graph <- graph |> activate("edges") |> 38 | mutate(hl=highlight_set_edges(c("degradation"), name="subtype_name")) 39 | 40 | } 41 | -------------------------------------------------------------------------------- /man/highlight_set_nodes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/highlight_functions.R 3 | \name{highlight_set_nodes} 4 | \alias{highlight_set_nodes} 5 | \title{highlight_set_nodes} 6 | \usage{ 7 | highlight_set_nodes( 8 | set, 9 | how = "all", 10 | name = "name", 11 | sep = " ", 12 | no_sep = FALSE, 13 | remove_dot = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{set}{set of identifiers} 18 | 19 | \item{how}{if `all`, if node contains multiple 20 | IDs separated by `sep`, highlight if all the IDs 21 | are in query. if `any`, highlight if one of the IDs 22 | is in query.} 23 | 24 | \item{name}{which column to search for} 25 | 26 | \item{sep}{separater for node names} 27 | 28 | \item{no_sep}{not separate node name} 29 | 30 | \item{remove_dot}{remove "..." after graphics name column} 31 | } 32 | \value{ 33 | boolean vector 34 | } 35 | \description{ 36 | identify if nodes are involved in specific queriy. 37 | if multiple IDs are listed after separation by `sep`, 38 | only return TRUE if all the IDs are in the query. 39 | } 40 | \examples{ 41 | graph <- create_test_pathway() 42 | ## Highlight set of nodes by specifying ID 43 | graph <- graph |> mutate(hl=highlight_set_nodes(c("hsa:51428"))) 44 | 45 | ## node column can be specified by `name` argument 46 | graph <- graph |> 47 | mutate(hl=highlight_set_nodes(c("DDX41"), name="graphics_name")) 48 | } 49 | -------------------------------------------------------------------------------- /man/module.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{module} 4 | \alias{module} 5 | \title{module 6 | KEGG module parsing function} 7 | \usage{ 8 | module(mid, use_cache = FALSE, directory = NULL) 9 | } 10 | \arguments{ 11 | \item{mid}{KEGG module ID} 12 | 13 | \item{use_cache}{use cache} 14 | 15 | \item{directory}{directory to save raw files} 16 | } 17 | \value{ 18 | list of module definition and reaction 19 | } 20 | \description{ 21 | module 22 | KEGG module parsing function 23 | } 24 | \examples{ 25 | module("M00003") 26 | } 27 | -------------------------------------------------------------------------------- /man/module_abundance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{module_abundance} 4 | \alias{module_abundance} 5 | \title{module_abundance 6 | weighted mean abundance of fraction of present KO in the block} 7 | \usage{ 8 | module_abundance(mod_id, vec, num = 1, calc = "weighted_mean") 9 | } 10 | \arguments{ 11 | \item{mod_id}{module ID} 12 | 13 | \item{vec}{KO-named vector of abundance without prefix `ko:`} 14 | 15 | \item{num}{definition number when multiple definitions are present} 16 | 17 | \item{calc}{calculation of final results, mean or weighted_mean} 18 | } 19 | \value{ 20 | numeric value 21 | } 22 | \description{ 23 | module_abundance 24 | weighted mean abundance of fraction of present KO in the block 25 | } 26 | \examples{ 27 | module_abundance("M00003",c(1.2) |> setNames("K00927")) 28 | } 29 | -------------------------------------------------------------------------------- /man/module_completeness.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{module_completeness} 4 | \alias{module_completeness} 5 | \title{module_completeness} 6 | \usage{ 7 | module_completeness(kmo, query, name = "1") 8 | } 9 | \arguments{ 10 | \item{kmo}{module object} 11 | 12 | \item{query}{vector of KO} 13 | 14 | \item{name}{name of definitions when multiple definitions are present} 15 | } 16 | \value{ 17 | tibble 18 | } 19 | \description{ 20 | This converts module definitions consisting of KO identifiers 21 | to the expression by converting `+` and ` ` to `AND`, and `,` to `OR`. 22 | After that, KO IDs specified by `query` is inserted to expression 23 | by `TRUE` or `FALSE`, and is evaluated. 24 | Please feel free to contact the bug, or modules that cannot be calculated. 25 | (Module definitions consisting of module IDs [M*] cannot be calculated) 26 | } 27 | \details{ 28 | Below is quoted from https://www.genome.jp/kegg/module.html 29 | 30 | `A space or a plus sign, representing a connection 31 | in the pathway or the molecular complex, 32 | is treated as an AND operator and a comma, 33 | used for alternatives, is treated as an OR operator. 34 | A minus sign designates an optional item in the complex.` 35 | } 36 | \examples{ 37 | ## Assess completeness based on one KO input 38 | test_complete <- module_completeness(create_test_module(), c("K00112")) 39 | } 40 | -------------------------------------------------------------------------------- /man/module_text.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{module_text} 4 | \alias{module_text} 5 | \title{module_text 6 | Obtain textual representation of module definition for all the blocks} 7 | \usage{ 8 | module_text( 9 | kmo, 10 | name = "1", 11 | candidate_ko = NULL, 12 | paint_colour = "tomato", 13 | convert = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{kmo}{module object} 18 | 19 | \item{name}{name of definition} 20 | 21 | \item{candidate_ko}{KO to highlight} 22 | 23 | \item{paint_colour}{color to highlight} 24 | 25 | \item{convert}{named vector converting the KO to gene name} 26 | } 27 | \value{ 28 | textual description of module definitions 29 | } 30 | \description{ 31 | module_text 32 | Obtain textual representation of module definition for all the blocks 33 | } 34 | \examples{ 35 | mo <- create_test_module() 36 | tex <- module_text(mo) 37 | } 38 | -------------------------------------------------------------------------------- /man/multi_pathway_native.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{multi_pathway_native} 4 | \alias{multi_pathway_native} 5 | \title{multi_pathway_native} 6 | \usage{ 7 | multi_pathway_native(pathways, row_num = 2, return_list = FALSE) 8 | } 9 | \arguments{ 10 | \item{pathways}{pathway vector} 11 | 12 | \item{row_num}{row number} 13 | 14 | \item{return_list}{return list of graphs instead of joined graph} 15 | } 16 | \value{ 17 | graph adjusted for the position 18 | } 19 | \description{ 20 | If you want to combine multiple KEGG pathways with their native coordinates, 21 | supply this function a vector of pathway IDs and row number. This returns the 22 | joined graph or list of graphs in which the coordinates are altered to panel 23 | the pathways. 24 | } 25 | \examples{ 26 | ## Pass multiple pathway IDs 27 | multi_pathway_native(list("hsa04110","hsa03460")) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /man/network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/network_functions.R 3 | \name{network} 4 | \alias{network} 5 | \title{KEGG network parsing function} 6 | \usage{ 7 | network(nid, use_cache = FALSE, directory = NULL) 8 | } 9 | \arguments{ 10 | \item{nid}{KEGG NETWORK ID} 11 | 12 | \item{use_cache}{use cache} 13 | 14 | \item{directory}{directory to save raw files} 15 | } 16 | \value{ 17 | list of network definition 18 | } 19 | \description{ 20 | parsing the network elements starting with N 21 | } 22 | \examples{ 23 | network("N00002") 24 | } 25 | -------------------------------------------------------------------------------- /man/network_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/network_functions.R 3 | \name{network_graph} 4 | \alias{network_graph} 5 | \title{network_graph} 6 | \usage{ 7 | network_graph(kne, type = "definition") 8 | } 9 | \arguments{ 10 | \item{kne}{network object} 11 | 12 | \item{type}{definition or expanded} 13 | } 14 | \value{ 15 | tbl_graph 16 | } 17 | \description{ 18 | obtain tbl_graph of KEGG network 19 | } 20 | \examples{ 21 | ne <- create_test_network() 22 | neg <- network_graph(ne) 23 | } 24 | -------------------------------------------------------------------------------- /man/node_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{node_matrix} 4 | \alias{node_matrix} 5 | \title{node_matrix} 6 | \usage{ 7 | node_matrix( 8 | graph, 9 | mat, 10 | gene_type = "SYMBOL", 11 | org = "hsa", 12 | org_db = NULL, 13 | num_combine = mean, 14 | name = "name", 15 | sep = " ", 16 | remove_dot = TRUE 17 | ) 18 | } 19 | \arguments{ 20 | \item{graph}{tbl_graph to append values to} 21 | 22 | \item{mat}{matrix representing gene as row and sample as column} 23 | 24 | \item{gene_type}{gene ID of matrix row} 25 | 26 | \item{org}{organism ID to convert ID} 27 | 28 | \item{org_db}{organism database to convert ID} 29 | 30 | \item{num_combine}{function to combine multiple numeric values} 31 | 32 | \item{name}{name column in node data, default to node} 33 | 34 | \item{sep}{separater of name, default to " "} 35 | 36 | \item{remove_dot}{remove "..." in the name} 37 | } 38 | \value{ 39 | tbl_graph 40 | } 41 | \description{ 42 | given the matrix representing gene as row and sample as column, 43 | append the node value to node matrix and 44 | return tbl_graph object 45 | } 46 | \examples{ 47 | 48 | ## Append data.frame to tbl_graph 49 | graph <- create_test_pathway() 50 | num_df <- data.frame(row.names=c("6737","51428"), 51 | "sample1"=c(1.1,1.2), 52 | "sample2"=c(1.5,2.2), 53 | check.names=FALSE) 54 | graph <- graph |> node_matrix(num_df, gene_type="ENTREZID") 55 | 56 | } 57 | -------------------------------------------------------------------------------- /man/node_numeric.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{node_numeric} 4 | \alias{node_numeric} 5 | \title{node_numeric} 6 | \usage{ 7 | node_numeric( 8 | num, 9 | num_combine = mean, 10 | name = "name", 11 | how = "any", 12 | sep = " ", 13 | remove_dot = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{num}{named vector or tibble with id and value column} 18 | 19 | \item{num_combine}{how to combine number when multiple hit in the same node} 20 | 21 | \item{name}{name of column to match for} 22 | 23 | \item{how}{how to match the node IDs with the queries 'any' or 'all'} 24 | 25 | \item{sep}{separater for name, default to " "} 26 | 27 | \item{remove_dot}{remove "..." in the name} 28 | } 29 | \value{ 30 | numeric vector 31 | } 32 | \description{ 33 | simply add numeric attribute to node of tbl_graph 34 | } 35 | \examples{ 36 | graph <- create_test_pathway() 37 | graph <- graph |> 38 | mutate(num=node_numeric(c(1.1) |> setNames("hsa:6737"))) 39 | 40 | } 41 | -------------------------------------------------------------------------------- /man/obtain_sequential_module_definition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{obtain_sequential_module_definition} 4 | \alias{obtain_sequential_module_definition} 5 | \title{obtain_sequential_module_definition} 6 | \usage{ 7 | obtain_sequential_module_definition(kmo, name = "1", block = NULL) 8 | } 9 | \arguments{ 10 | \item{kmo}{module object} 11 | 12 | \item{name}{name of definition when multiple definitions are present} 13 | 14 | \item{block}{specify if need to parse specific block} 15 | } 16 | \value{ 17 | list of module definitions 18 | } 19 | \description{ 20 | Given module definition and block number, 21 | Recursively obtain graphical represencation of block and 22 | connect them by pseudo-nodes representing blocks. 23 | } 24 | \examples{ 25 | mo <- create_test_module() 26 | sequential_mod <- obtain_sequential_module_definition(mo) 27 | } 28 | -------------------------------------------------------------------------------- /man/output_overlay_image.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlay_functions.R 3 | \name{output_overlay_image} 4 | \alias{output_overlay_image} 5 | \title{output_overlay_image} 6 | \usage{ 7 | output_overlay_image( 8 | gg, 9 | with_legend = TRUE, 10 | use_cache = TRUE, 11 | high_res = FALSE, 12 | res = 72, 13 | out = NULL, 14 | directory = NULL, 15 | transparent_colors = c("#FFFFFF", "#BFBFFF", "#BFFFBF", "#7F7F7F", "#808080"), 16 | unlink = TRUE, 17 | with_legend_image = FALSE, 18 | legend_horiz = FALSE, 19 | legend_space = 100 20 | ) 21 | } 22 | \arguments{ 23 | \item{gg}{ggraph object} 24 | 25 | \item{with_legend}{if legend (group-box) is in gtable, output them} 26 | 27 | \item{use_cache}{use BiocFileCache for caching the image} 28 | 29 | \item{high_res}{use 2x resolution image} 30 | 31 | \item{res}{resolution parameter passed to saving the ggplot2 image} 32 | 33 | \item{out}{output file name} 34 | 35 | \item{directory}{specify if you have already downloaded the image} 36 | 37 | \item{transparent_colors}{transparent colors} 38 | 39 | \item{unlink}{unlink the intermediate image} 40 | 41 | \item{with_legend_image}{append legend image instead of using gtable} 42 | 43 | \item{legend_horiz}{append legend to the bottom of the image} 44 | 45 | \item{legend_space}{legend spacing specification (in pixel)} 46 | } 47 | \value{ 48 | output the image and return the path 49 | } 50 | \description{ 51 | The function first exports the image, combine it with the original image. 52 | Note that if the legend is outside the pathway image, the result will not 53 | show it correctly. Place the legend inside the panel by adding the theme 54 | such as theme(legend.position=c(0.5, 0.5)). 55 | } 56 | \details{ 57 | If the legend must be placed outside the image, the users can set 58 | with_legend_image to TRUE. This will create another legend only image 59 | and concatenate it with the pathway image. legend_space option can be 60 | specified to control the spacing for the legend. If need to append horizontal 61 | legend, enable legend_horiz option. 62 | 63 | By default, unlink option is enabled which means the function will delete 64 | the intermediate files. 65 | } 66 | \examples{ 67 | \dontrun{ 68 | ouput_overlay_image(ggraph(pathway("hsa04110"))) 69 | } 70 | 71 | 72 | } 73 | -------------------------------------------------------------------------------- /man/overlay_raw_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlay_functions.R 3 | \name{overlay_raw_map} 4 | \alias{overlay_raw_map} 5 | \title{overlay_raw_map} 6 | \usage{ 7 | overlay_raw_map( 8 | pid = NULL, 9 | directory = NULL, 10 | transparent_colors = c("#FFFFFF", "#BFBFFF", "#BFFFBF"), 11 | adjust = FALSE, 12 | adjust_manual_x = NULL, 13 | adjust_manual_y = NULL, 14 | clip = FALSE, 15 | use_cache = TRUE, 16 | interpolate = TRUE, 17 | high_res = FALSE, 18 | fix_coordinates = TRUE 19 | ) 20 | } 21 | \arguments{ 22 | \item{pid}{pathway ID} 23 | 24 | \item{directory}{directory to store images if not use cache} 25 | 26 | \item{transparent_colors}{make these colors transparent to overlay 27 | Typical choice of colors would be: 28 | "#CCCCCC", "#FFFFFF","#BFBFFF","#BFFFBF", "#7F7F7F", "#808080", 29 | "#ADADAD","#838383","#B3B3B3"} 30 | 31 | \item{adjust}{adjust the x- and y-axis location by 0.5 in data coordinates} 32 | 33 | \item{adjust_manual_x}{adjust the position manually for x-axis 34 | Override `adjust`} 35 | 36 | \item{adjust_manual_y}{adjust the position manually for y-axis 37 | Override `adjust`} 38 | 39 | \item{clip}{clip the both end of x- and y-axis by one dot} 40 | 41 | \item{use_cache}{whether to use BiocFileCache()} 42 | 43 | \item{interpolate}{parameter in annotation_raster()} 44 | 45 | \item{high_res}{Use high resolution (2x) image for the overlay} 46 | 47 | \item{fix_coordinates}{fix the coordinate (coord_fixed)} 48 | } 49 | \value{ 50 | ggplot2 object 51 | } 52 | \description{ 53 | Overlay the raw KEGG pathway image on ggraph 54 | } 55 | \examples{ 56 | ## Need `pathway_id` column in graph 57 | ## if the function is to automatically infer 58 | graph <- create_test_pathway() |> mutate(pathway_id="hsa04110") 59 | ggraph(graph) + overlay_raw_map() 60 | 61 | } 62 | -------------------------------------------------------------------------------- /man/pathway.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pathway_functions.R 3 | \name{pathway} 4 | \alias{pathway} 5 | \title{pathway} 6 | \usage{ 7 | pathway( 8 | pid, 9 | directory = NULL, 10 | use_cache = FALSE, 11 | group_rect_nudge = 2, 12 | node_rect_nudge = 0, 13 | invert_y = TRUE, 14 | add_pathway_id = TRUE, 15 | return_tbl_graph = TRUE, 16 | return_image = FALSE 17 | ) 18 | } 19 | \arguments{ 20 | \item{pid}{pathway id} 21 | 22 | \item{directory}{directory to download KGML} 23 | 24 | \item{use_cache}{whether to use BiocFileCache} 25 | 26 | \item{group_rect_nudge}{nudge the position of group node 27 | default to add slight increase to show the group node} 28 | 29 | \item{node_rect_nudge}{nudge the position of all node} 30 | 31 | \item{invert_y}{invert the y position to match with R graphics} 32 | 33 | \item{add_pathway_id}{add pathway id to graph, default to TRUE 34 | needed for the downstream analysis} 35 | 36 | \item{return_tbl_graph}{return tbl_graph object, if FALSE, return igraph} 37 | 38 | \item{return_image}{return the image URL} 39 | } 40 | \value{ 41 | tbl_graph by default 42 | } 43 | \description{ 44 | KEGG pathway parsing function 45 | } 46 | \examples{ 47 | pathway("hsa04110") 48 | } 49 | -------------------------------------------------------------------------------- /man/pathway_abundance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_functions.R 3 | \name{pathway_abundance} 4 | \alias{pathway_abundance} 5 | \title{pathway_abundance} 6 | \usage{ 7 | pathway_abundance(id, vec, num = 1) 8 | } 9 | \arguments{ 10 | \item{id}{pathway id} 11 | 12 | \item{vec}{named vector of abundance} 13 | 14 | \item{num}{number of module definition} 15 | } 16 | \value{ 17 | numeric value 18 | } 19 | \description{ 20 | pathway_abundance 21 | } 22 | \examples{ 23 | pathway_abundance("ko00270", c(1.2) |> `setNames`("K00927")) 24 | } 25 | -------------------------------------------------------------------------------- /man/pathway_info.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pathway_functions.R 3 | \name{pathway_info} 4 | \alias{pathway_info} 5 | \title{pathway_info} 6 | \usage{ 7 | pathway_info(pid, use_cache = FALSE, directory = NULL) 8 | } 9 | \arguments{ 10 | \item{pid}{KEGG Pathway id} 11 | 12 | \item{use_cache}{whether to use cache} 13 | 14 | \item{directory}{directory of file} 15 | } 16 | \value{ 17 | list of orthology and module contained in the pathway 18 | } 19 | \description{ 20 | obtain the list of pathway information 21 | } 22 | \examples{ 23 | pathway_info("hsa04110") 24 | } 25 | -------------------------------------------------------------------------------- /man/plot_kegg_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{plot_kegg_network} 4 | \alias{plot_kegg_network} 5 | \title{plot_kegg_network} 6 | \usage{ 7 | plot_kegg_network(g, layout = "nicely") 8 | } 9 | \arguments{ 10 | \item{g}{graph object returned by `network()`} 11 | 12 | \item{layout}{layout to be used, default to nicely} 13 | } 14 | \value{ 15 | ggplot2 object 16 | } 17 | \description{ 18 | plot the output of network_graph 19 | } 20 | \examples{ 21 | ne <- create_test_network() 22 | ## Output of `network_graph` must be used with plot_kegg_network 23 | neg <- network_graph(ne) 24 | plt <- plot_kegg_network(neg) 25 | } 26 | -------------------------------------------------------------------------------- /man/plot_module_blocks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{plot_module_blocks} 4 | \alias{plot_module_blocks} 5 | \title{plot_module_blocks} 6 | \usage{ 7 | plot_module_blocks(all_steps, layout = "kk") 8 | } 9 | \arguments{ 10 | \item{all_steps}{the result of `obtain_sequential_module_definition()`} 11 | 12 | \item{layout}{ggraph layout parameter} 13 | } 14 | \value{ 15 | ggplot2 object 16 | } 17 | \description{ 18 | wrapper function for plotting network representation of 19 | module definition blocks 20 | } 21 | \examples{ 22 | mo <- create_test_module() 23 | ## The output of `obtain_sequential_module_definition` 24 | ## is used for `plot_module_blocks()` 25 | sequential_mod <- obtain_sequential_module_definition(mo) 26 | plt <- plot_module_blocks(sequential_mod) 27 | } 28 | -------------------------------------------------------------------------------- /man/plot_module_text.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_functions.R 3 | \name{plot_module_text} 4 | \alias{plot_module_text} 5 | \title{plot_module_text} 6 | \usage{ 7 | plot_module_text(plot_list, show_name = "name") 8 | } 9 | \arguments{ 10 | \item{plot_list}{the result of `module_text()`} 11 | 12 | \item{show_name}{name column to be plotted} 13 | } 14 | \value{ 15 | ggplot2 object 16 | } 17 | \description{ 18 | plot the text representation of KEGG modules 19 | } 20 | \examples{ 21 | 22 | mo <- create_test_module() 23 | 24 | ## The output of `module_text` is used for `plot_module_text()` 25 | tex <- module_text(mo) 26 | plt <- plot_module_text(tex) 27 | 28 | } 29 | -------------------------------------------------------------------------------- /man/process_line.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pathway_functions.R 3 | \name{process_line} 4 | \alias{process_line} 5 | \title{process_line} 6 | \usage{ 7 | process_line(g, invert_y = TRUE, verbose = FALSE) 8 | } 9 | \arguments{ 10 | \item{g}{graph} 11 | 12 | \item{invert_y}{whether to invert the position, default to TRUE 13 | should match with `pathway` function} 14 | 15 | \item{verbose}{show progress} 16 | } 17 | \value{ 18 | tbl_graph 19 | } 20 | \description{ 21 | process the KGML containing graphics type of `line`, like 22 | global maps e.g. ko01100. Recursively add nodes and edges 23 | connecting them based on `coords` properties in KGML. 24 | } 25 | \details{ 26 | We cannot show directed arrows, as coords are not ordered to show direction. 27 | } 28 | \examples{ 29 | ## For those containing nodes with the graphic type of `line`, 30 | ## parse the coords attributes to edges. 31 | gm_test <- create_test_pathway(line=TRUE) 32 | test <- process_line(gm_test) 33 | } 34 | -------------------------------------------------------------------------------- /man/process_reaction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pathway_functions.R 3 | \name{process_reaction} 4 | \alias{process_reaction} 5 | \title{process_reaction} 6 | \usage{ 7 | process_reaction(g, single_edge = FALSE, keep_no_reaction = TRUE) 8 | } 9 | \arguments{ 10 | \item{g}{graph} 11 | 12 | \item{single_edge}{discard one edge when edge type is `reversible`} 13 | 14 | \item{keep_no_reaction}{keep edges not related to reaction} 15 | } 16 | \value{ 17 | tbl_graph 18 | } 19 | \description{ 20 | process the kgml of global maps 21 | e.g. in ko01100 22 | } 23 | \details{ 24 | Typically, `process_line` function is used to draw relationships 25 | as in the original KGML positions, however, the `coords` properties 26 | is not considering the direction of reactions (substrate -> product), 27 | thus if it is preferred, `process_reaction` is used to populate 28 | new edges corresponding to `substrate -> product` and `product -> substrate` 29 | if the reaction is reversible. 30 | } 31 | \examples{ 32 | gm_test <- create_test_pathway(line=TRUE) 33 | test <- process_reaction(gm_test) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/rawMap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggkegg.R 3 | \name{rawMap} 4 | \alias{rawMap} 5 | \title{rawMap} 6 | \usage{ 7 | rawMap( 8 | enrich, 9 | pathway_number = 1, 10 | pid = NULL, 11 | fill_color = "red", 12 | how = "any", 13 | white_background = TRUE, 14 | infer = FALSE, 15 | name = "name", 16 | sep = " ", 17 | remove_dot = TRUE 18 | ) 19 | } 20 | \arguments{ 21 | \item{enrich}{enrichResult or gseaResult class object, or list of them} 22 | 23 | \item{pathway_number}{pathway number sorted by p-values} 24 | 25 | \item{pid}{pathway id, override pathway_number if specified} 26 | 27 | \item{fill_color}{color for genes} 28 | 29 | \item{how}{how to match the node IDs with the queries 'any' or 'all'} 30 | 31 | \item{white_background}{fill background color white} 32 | 33 | \item{infer}{if TRUE, append the prefix to queried IDs based on pathway ID} 34 | 35 | \item{name}{name of column to match for} 36 | 37 | \item{sep}{separater for name, default to " "} 38 | 39 | \item{remove_dot}{remove "..." in the name} 40 | } 41 | \value{ 42 | ggraph with overlaid KEGG map 43 | } 44 | \description{ 45 | given enrichResult class object, 46 | return the ggplot object with raw KEGG map overlaid on 47 | enriched pathway. Can be used with the function such as 48 | `clusterProfiler::enrichKEGG` and `MicrobiomeProfiler::enrichKO()` 49 | } 50 | \examples{ 51 | if (require("clusterProfiler")) { 52 | cp <- enrichKEGG(c("1029","4171")) 53 | ## Multiple class object can be passed by list 54 | rawMap(list(cp,cp), pid="hsa04110") 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /man/rawValue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggkegg.R 3 | \name{rawValue} 4 | \alias{rawValue} 5 | \title{rawValue} 6 | \usage{ 7 | rawValue( 8 | values, 9 | pid = NULL, 10 | column = "name", 11 | show_type = "gene", 12 | how = "any", 13 | white_background = TRUE, 14 | auto_add = FALSE, 15 | man_graph = NULL, 16 | sep = " ", 17 | remove_dot = TRUE 18 | ) 19 | } 20 | \arguments{ 21 | \item{values}{named vector, or list of them} 22 | 23 | \item{pid}{pathway id} 24 | 25 | \item{column}{name of column to match for} 26 | 27 | \item{show_type}{type to be shown} 28 | 29 | \item{how}{how to match the node IDs with the queries 'any' or 'all'} 30 | 31 | \item{white_background}{fill background color white} 32 | 33 | \item{auto_add}{automatically add prefix based on pathway prefix} 34 | 35 | \item{man_graph}{provide manual tbl_graph} 36 | 37 | \item{sep}{separater for name, default to " "} 38 | 39 | \item{remove_dot}{remove "..." in the name 40 | typically, "gene", "ortholog", or "compound"} 41 | } 42 | \value{ 43 | ggraph with overlaid KEGG map 44 | } 45 | \description{ 46 | given named vector of quantitative values, 47 | return the ggplot object with raw KEGG map overlaid. 48 | Colors can be changed afterwards. 49 | } 50 | \examples{ 51 | ## Colorize by passing the named vector of numeric values 52 | rv <- rawValue(c(1.1) |> setNames("hsa:6737"), 53 | man_graph=create_test_pathway()) 54 | } 55 | -------------------------------------------------------------------------------- /man/return_line_compounds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{return_line_compounds} 4 | \alias{return_line_compounds} 5 | \title{return_line_compounds} 6 | \usage{ 7 | return_line_compounds(g, orig) 8 | } 9 | \arguments{ 10 | \item{g}{tbl_graph object} 11 | 12 | \item{orig}{original edge ID} 13 | } 14 | \value{ 15 | vector of original compound node IDs 16 | } 17 | \description{ 18 | In the map, where lines are converted to edges, 19 | identify compounds that are linked by the reaction. 20 | Give the original edge ID of KGML (orig.id in edge table), and 21 | return the original compound node ID 22 | } 23 | \examples{ 24 | ## For those containing nodes with the graphic type of `line` 25 | ## This returns no IDs as no edges are present 26 | gm_test <- create_test_pathway(line=TRUE) 27 | test <- process_line(gm_test) |> return_line_compounds(1) 28 | } 29 | -------------------------------------------------------------------------------- /man/stamp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stamp.R 3 | \name{stamp} 4 | \alias{stamp} 5 | \title{stamp} 6 | \usage{ 7 | stamp(name, color = "red", which_column = "name", xval = 2, yval = 2) 8 | } 9 | \arguments{ 10 | \item{name}{name of the nodes} 11 | 12 | \item{color}{color of the stamp} 13 | 14 | \item{which_column}{which node column to search} 15 | 16 | \item{xval}{adjustment value for x-axis} 17 | 18 | \item{yval}{adjustment value for y-axis} 19 | } 20 | \value{ 21 | ggplot2 object 22 | } 23 | \description{ 24 | place stamp on the specified node 25 | } 26 | \examples{ 27 | test_pathway <- create_test_pathway() 28 | plt <- ggraph(test_pathway, layout="manual", x=x, y=y) + 29 | stamp("hsa:6737") 30 | } 31 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(ggkegg) 11 | 12 | test_check("ggkegg") 13 | -------------------------------------------------------------------------------- /tests/testthat/test-highlight.R: -------------------------------------------------------------------------------- 1 | test_that("Highlight node functions without errors", { 2 | graph <- create_test_pathway() 3 | expect_error(graph |> mutate(hl=highlight_set_nodes(c("hsa:51428"))), NA) 4 | }) 5 | test_that("Highlight edge functions without errors", { 6 | graph <- create_test_pathway() 7 | expect_error(graph |> activate("edges") |> 8 | mutate(hl=highlight_set_edges(c("degradation"), 9 | name="subtype_name")), NA) 10 | }) 11 | test_that("Highlight module functions without errors", { 12 | graph <- create_test_pathway() 13 | mo <- create_test_module() 14 | expect_error(graph <- graph |> highlight_module(mo), NA) 15 | }) 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /tests/testthat/test-module.R: -------------------------------------------------------------------------------- 1 | test_that("Module parsing to text and network without errors", { 2 | expect_error( create_test_module(), NA) 3 | mod <- create_test_module() 4 | 5 | ## Text parsing 6 | expect_error( module_text(mod), NA) 7 | expect_error( module_text(mod) |> plot_module_text(), NA) 8 | mod <- module("M00004") 9 | expect_error( module_text(mod), NA) 10 | expect_error( module_text(mod) |> plot_module_text(), NA) 11 | 12 | ## Network parsing 13 | expect_error( obtain_sequential_module_definition(mod) |> 14 | plot_module_blocks(), NA) 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-network.R: -------------------------------------------------------------------------------- 1 | test_that("Network parsing without errors", { 2 | expect_error( create_test_network(), NA) 3 | net <- create_test_network() 4 | expect_error( net |> network_graph() |> plot_kegg_network(), NA) 5 | net <- network("N00002") 6 | expect_error( net |> network_graph() |> plot_kegg_network(), NA) 7 | }) 8 | -------------------------------------------------------------------------------- /tests/testthat/test-pathway.R: -------------------------------------------------------------------------------- 1 | test_that("Generate test pathway without errors", { 2 | expect_error( create_test_pathway(), NA) 3 | }) 4 | test_that("Pathway downloading without errors", { 5 | expect_error( pathway("hsa04110"), NA) 6 | }) 7 | test_that("process_line without errors", { 8 | expect_error( create_test_pathway(line=TRUE) |> process_line(), NA) 9 | }) 10 | test_that("process_reaction without errors", { 11 | expect_error( create_test_pathway(line=TRUE) |> process_reaction(), NA) 12 | }) 13 | test_that("ggkegg (pathway) without errors", { 14 | expect_error( ggkegg("hsa04110"), NA) 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | test_that("Do utils without errors", { 2 | graph <- create_test_pathway() 3 | res <- data.frame(row.names="6737",log2FoldChange=1.2) 4 | expect_error( graph |> 5 | mutate(num=assign_deseq2(res, gene_type="ENTREZID")), 6 | NA) 7 | expect_error( graph |> activate("edges") |> 8 | mutate(num=edge_numeric_sum(c(1.2,-1.2) |> 9 | setNames(c("TRIM21","DDX41")), 10 | name="graphics_name")), 11 | NA) 12 | }) 13 | 14 | test_that("edge_matrix without errors", { 15 | graph <- create_test_pathway() 16 | num_df <- data.frame(row.names=c("6737","51428"), 17 | "sample1"=c(1.1,1.2), 18 | "sample2"=c(1.1,1.2), 19 | check.names=FALSE) 20 | expect_error(graph <- graph |> edge_matrix(num_df, gene_type="ENTREZID"), 21 | NA) 22 | }) 23 | 24 | -------------------------------------------------------------------------------- /vignettes/usage_of_ggkegg.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "ggkegg" 3 | author: "Noriaki Sato" 4 | output: 5 | BiocStyle::html_document: 6 | toc: true 7 | toc_float: true 8 | vignette: > 9 | %\VignetteIndexEntry{ggkegg} 10 | %\VignetteEngine{knitr::rmarkdown} 11 | \usepackage[utf8]{inputenc} 12 | --- 13 | 14 | ```{r setup, include=FALSE} 15 | knitr::opts_chunk$set(echo = TRUE, 16 | fig.width=12, 17 | fig.height=6, 18 | warning=FALSE, 19 | message=FALSE) 20 | ``` 21 | 22 | # ggkegg 23 | 24 | This package aims to import, parse, and analyze KEGG data such as KEGG PATHWAY and KEGG MODULE. The package supports visualizing KEGG information using ggplot2 and ggraph through using the grammar of graphics. The package enables the direct visualization of the results from various omics analysis packages and the connection to the other tidy manipulation packages. In this documentation, the basic usage of `ggkegg` is presented. Please refer to [the documentation](https://noriakis.github.io/software/ggkegg) for the detailed usage. 25 | 26 | ## Introduction 27 | 28 | There are many great packages performing KEGG PATHWAY analysis in R. `r BiocStyle::Biocpkg("pathview")` fetches KEGG PATHWAY information, enabling the output of images reflecting various user-defined values on the map. `r BiocStyle::Biocpkg("KEGGlincs")` can overlay LINCS data to KEGG PATHWAY, and examine the map using Cytoscape. `r BiocStyle::Biocpkg("graphite")` acquires pathways including KEGG and Reactome, convert them into graphNEL format, and provides an interface for topological analysis. `r BiocStyle::Biocpkg("KEGGgraph")` also downloads KEGG PATHWAY information and converts it into a format analyzable in R. Extending to these packages, the purpose of developing this package, `ggkegg`, is to allow for tidy manipulation of KEGG information by the power of `tidygraph`, to plot the relevant information in flexible and customizable ways using grammar of graphics, to examine the global and overview maps consisting of compounds and reactions. 29 | 30 | ## Pathway 31 | 32 | The users can obtain a KEGG PATHWAY `tbl_graph` by `pathway` function. If you want to cache the file, please specify `use_cache=TRUE`, and if you already have the XML files of the pathway, please specify the directory of the file with `directory` argument. Here, we obtain `Cell cycle` pathway (`hsa04110`) using cache. `pathway_id` column is inserted to node and edge by default, which allows for the identification of the pathway ID in the other functions. 33 | 34 | ```{r pathway1, message=FALSE, warning=FALSE, fig.width=6, fig.height=3} 35 | library(ggkegg) 36 | library(tidygraph) 37 | library(dplyr) 38 | graph <- ggkegg::pathway("hsa04110", use_cache=TRUE) 39 | graph 40 | ``` 41 | 42 | The output can be analysed readily using `tidygraph` and `dplyr` verbs. For example, centrality calculations can be performed as follows. 43 | 44 | ```{r pathway1_1, message=FALSE, warning=FALSE, fig.width=6, fig.height=3} 45 | graph |> 46 | mutate(degree=centrality_degree(mode="all"), 47 | betweenness=centrality_betweenness()) |> 48 | activate(nodes) |> 49 | filter(type=="gene") |> 50 | arrange(desc(degree)) |> 51 | as_tibble() |> 52 | relocate(degree, betweenness) 53 | ``` 54 | 55 | ### Plot the pathway using `ggraph` 56 | 57 | The parsed `tbl_graph` can be used to plot the information by `ggraph` using the grammar of graphics. The components in the graph such as nodes, edges, and text can be plotted layer by layer. 58 | 59 | ```{r plot_pathway1, message=FALSE, warning=FALSE, fig.width=10, fig.height=8} 60 | graph <- graph |> mutate(showname=strsplit(graphics_name, ",") |> 61 | vapply("[", 1, FUN.VALUE="a")) 62 | 63 | ggraph(graph, layout="manual", x=x, y=y)+ 64 | geom_edge_parallel(aes(linetype=subtype_name), 65 | arrow=arrow(length=unit(1,"mm"), type="closed"), 66 | end_cap=circle(1,"cm"), 67 | start_cap=circle(1,"cm"))+ 68 | geom_node_rect(aes(fill=I(bgcolor), 69 | filter=type == "gene"), 70 | color="black")+ 71 | geom_node_text(aes(label=showname, 72 | filter=type == "gene"), 73 | size=2)+ 74 | theme_void() 75 | ``` 76 | 77 | Besides the default ordering, various layout functions in `igraph` and `ggraph` can be used. 78 | 79 | ```{r plot_pathway2, message=FALSE, warning=FALSE, fig.width=10, fig.height=10} 80 | graph |> mutate(x=NULL, y=NULL) |> 81 | ggraph(layout="nicely")+ 82 | geom_edge_parallel(aes(color=subtype_name), 83 | arrow=arrow(length=unit(1,"mm"), type="closed"), 84 | end_cap=circle(0.1,"cm"), 85 | start_cap=circle(0.1,"cm"))+ 86 | geom_node_point(aes(filter=type == "gene"), 87 | color="black")+ 88 | geom_node_point(aes(filter=type == "group"), 89 | color="tomato")+ 90 | geom_node_text(aes(label=showname, 91 | filter=type == "gene"), 92 | size=3, repel=TRUE, bg.colour="white")+ 93 | scale_edge_color_viridis(discrete=TRUE)+ 94 | theme_void() 95 | ``` 96 | 97 | ## Converting identifiers 98 | 99 | In the above example, `graphics_name` column in the node table were used, which are available in the default KGML file. Some of them are truncated, and the user can convert identifiers using `convert_id` function to be used in `mutate`. One can pipe the functions to convert `name` column consisting of `hsa` KEGG gene IDs in node table of `tbl_graph`. 100 | 101 | ```{r convert, message=FALSE, warning=FALSE} 102 | graph |> 103 | activate(nodes) |> 104 | mutate(hsa=convert_id("hsa")) |> 105 | filter(type == "gene") |> 106 | as_tibble() |> 107 | relocate(hsa) 108 | ``` 109 | 110 | ### Highlighting set of nodes and edges 111 | 112 | `highlight_set_nodes()` and `highlight_set_edges()` can be used to identify nodes that satisfy query IDs. Nodes often have multiple IDs, and user can choose `how="any"` (if one of identifiers in the nodes matches the query) or `how="all"` (if all of the identifiers in the nodes match the query) to highlight. 113 | 114 | ```{r highlight, message=FALSE, warning=FALSE, fig.width=10, fig.height=8} 115 | graph |> 116 | activate(nodes) |> 117 | mutate(highlight=highlight_set_nodes("hsa:7157")) |> 118 | ggraph(layout="manual", x=x, y=y)+ 119 | geom_node_rect(aes(fill=I(bgcolor), 120 | filter=type == "gene"), color="black")+ 121 | geom_node_rect(aes(fill="tomato", filter=highlight), color="black")+ 122 | geom_node_text(aes(label=showname, 123 | filter=type == "gene"), size=2)+ 124 | geom_edge_parallel(aes(linetype=subtype_name), 125 | arrow=arrow(length=unit(1,"mm"), 126 | type="closed"), 127 | end_cap=circle(1,"cm"), 128 | start_cap=circle(1,"cm"))+ 129 | theme_void() 130 | ``` 131 | 132 | 133 | ### Overlaying raw KEGG image 134 | 135 | We can use `overlay_raw_map` to overlay the raw KEGG images on the created `ggraph`. 136 | The node and text can be directly customized by using various geoms, effects such as `ggfx`, and scaling functions. 137 | The code below creates nodes using default parsed background color and just overlay the image. 138 | 139 | ```{r example_raw, message=FALSE, warning=FALSE, eval=TRUE} 140 | graph |> 141 | mutate(degree=centrality_degree(mode="all")) |> 142 | ggraph(graph, layout="manual", x=x, y=y)+ 143 | geom_node_rect(aes(fill=degree, 144 | filter=type == "gene"))+ 145 | overlay_raw_map()+ 146 | scale_fill_viridis_c()+ 147 | theme_void() 148 | ``` 149 | 150 | ## Module and Network 151 | 152 | ### Parsing module 153 | 154 | KEGG MODULE can be parsed and used in the analysis. The formula to obtain module is the same as pathway. Here, we use test pathway which contains two KEGG ORTHOLOGY, two compounds and one reaction. 155 | This will create `kegg_module` class object storing definition and reactions. 156 | 157 | ```{r module2, eval=TRUE} 158 | mod <- module("M00002", use_cache=TRUE) 159 | mod 160 | ``` 161 | 162 | ### Visualizing module 163 | 164 | The module can be visualized by text-based or network-based, depicting how the KOs interact each other. 165 | For text based visualization like the one shown in the original KEGG website, `module_text` can be used. 166 | 167 | ```{r mod_vis1, message=FALSE, warning=FALSE, fig.width=8, fig.height=4} 168 | ## Text-based 169 | mod |> 170 | module_text() |> ## return data.frame 171 | plot_module_text() 172 | ``` 173 | 174 | For network based visualization, `obtain_sequential_module_definition` can be used. 175 | 176 | ```{r mod_vis2, message=FALSE, warning=FALSE, fig.width=8, fig.height=8} 177 | ## Network-based 178 | mod |> 179 | obtain_sequential_module_definition() |> ## return tbl_graph 180 | plot_module_blocks() 181 | ``` 182 | 183 | We can assess module completeness, as well as user-defined module abundances. Please refer to [the module section of documentation](https://noriakis.github.io/software/ggkegg/module.html). The network can be created by the same way, and create `kegg_network` class object storing information. 184 | 185 | ### Use with the other omics packages 186 | 187 | The package supports direct importing and visualization, and investigation of the results of the other packages such as enrichment analysis results from `clusterProfiler` and differential expression analysis results from `DESeq2`. Pplease refer to [use cases](https://noriakis.github.io/software/ggkegg/usecases.html) in the documentation for more detailed use cases. 188 | 189 | ## Wrapper function `ggkegg` 190 | 191 | `ggkegg` function can be used with various input. For example, if the user provides pathway ID, the function automatically returns the `ggraph` with the original layout, which can be used directly for stacking geoms. The other supported IDs are module, network, and also the `enrichResult` object, and the other options such as converting IDs are available. 192 | 193 | ```{r ggkegg, fig.width=6, fig.height=6} 194 | ggkegg("bpsp00270") |> class() ## Returns ggraph 195 | ggkegg("N00002") ## Returns the KEGG NETWORK plot 196 | ``` 197 | 198 | 199 | ```{r} 200 | sessionInfo() 201 | ``` --------------------------------------------------------------------------------