Skip to content

Commit

Permalink
linting
Browse files Browse the repository at this point in the history
  • Loading branch information
@noriakis
noriakis committed Aug 24, 2023
1 parent b15518b commit 786ec0f
Show file tree
Hide file tree
Showing 17 changed files with 272 additions and 213 deletions.
17 changes: 9 additions & 8 deletions R/ggkegg.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,12 +93,14 @@ ggkegg <- function(pid,
} else if (module_definition_type == "network") {
return(obtain_sequential_module_definition(mod))
} else {
stop("Please specify `network` or `text` to module_definition_type")
stop("Please specify `network` or `text`",
" to module_definition_type")
}
} else if (module_type == "reaction") {
return(mod@reaction_graph)
} else {
stop("Please specify `reaction` or `definition` to module_type")
stop("Please specify `reaction` or `definition`",
" to module_type")
}
}
}
Expand Down Expand Up @@ -141,7 +143,7 @@ ggkegg <- function(pid,
if (!is.null(enrich_attribute)) {
bools <- vapply(V(g)$name, function(xx) {
in_node <- strsplit(xx, " ") |> unlist() |> unique()
if (length(intersect(in_node, enrich_attribute)) >= 1) { ## Only `any`
if (length(intersect(in_node, enrich_attribute)) >= 1) {
return(TRUE)
} else {
return(FALSE)
Expand Down Expand Up @@ -224,7 +226,8 @@ rawMap <- function(enrich, pathway_number=1, pid=NULL,

number <- length(enrich)
if (length(fill_color) != number) {
qqcat("Length of fill_color and enrich mismatches, taking first color\n")
qqcat("Length of fill_color and enrich mismatches,",
" taking first color\n")
fill_color <- rep(fill_color[1], number)
}
if (is.list(enrich)) {
Expand Down Expand Up @@ -275,8 +278,7 @@ rawMap <- function(enrich, pathway_number=1, pid=NULL,
gg <- gg + overlay_raw_map()+theme_void()
}
if (white_background) {
gg + theme(panel.background = element_rect(fill = 'white',
colour = 'white'))
gg + theme(panel.background=element_rect(fill='white', colour='white'))
} else {
gg
}
Expand Down Expand Up @@ -360,8 +362,7 @@ rawValue <- function(values, pid=NULL, column="name", show_type="gene",
gg <- gg + overlay_raw_map()+theme_void()
}
if (white_background) {
gg + theme(panel.background = element_rect(fill = 'white',
colour = 'white'))
gg + theme(panel.background=element_rect(fill='white', colour='white'))
} else {
gg
}
Expand Down
86 changes: 50 additions & 36 deletions R/module_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ module <- function(mid, use_cache=FALSE, directory=NULL) {
con <- file(dest, "r")
content_list <- list()
while ( TRUE ) {
line <- readLines(con, n = 1)
line <- readLines(con, n=1)
if ( length(line) == 0 ) {
break
}
Expand Down Expand Up @@ -238,8 +238,10 @@ module_text <- function(kmo, name="1", candidate_ko=NULL,
#'
#' Below is quoted from https://www.genome.jp/kegg/module.html
#'
#' `A space or a plus sign, representing a connection in the pathway or the molecular complex,
#' is treated as an AND operator and a comma, used for alternatives, is treated as an OR operator.
#' `A space or a plus sign, representing a connection
#' in the pathway or the molecular complex,
#' is treated as an AND operator and a comma,
#' used for alternatives, is treated as an OR operator.
#' A minus sign designates an optional item in the complex.`
#'
#' @param kmo module object
Expand Down Expand Up @@ -393,7 +395,7 @@ module_graph <- function(input_string, skip_minus=FALSE) {
converted_string <- gsub(posmat$text[i],
posmat$name[i],
converted_string,
fixed = TRUE)
fixed=TRUE)
posmat$text[(i+1):nrow(posmat)] <- gsub(posmat$text[i],
posmat$name[i],
posmat$text[(i+1):nrow(posmat)],
Expand Down Expand Up @@ -440,7 +442,7 @@ module_graph <- function(input_string, skip_minus=FALSE) {
converted_string <- gsub(css$text[i],
css$name[i],
converted_string,
fixed = TRUE)
fixed=TRUE)
}
}
} else {
Expand All @@ -455,7 +457,7 @@ module_graph <- function(input_string, skip_minus=FALSE) {
converted_string <- gsub(css$text[i],
css$name[i],
converted_string,
fixed = TRUE)
fixed=TRUE)
}
}
}
Expand All @@ -475,7 +477,7 @@ module_graph <- function(input_string, skip_minus=FALSE) {

if (!is.null(rels)) {
rels <- rels |> data.frame() |> `colnames<-`(c("from", "to", "type"))
relg <- graph_from_data_frame(rels, directed = FALSE)
relg <- graph_from_data_frame(rels, directed=FALSE)
g <- simplify(relg, edge.attr.comb="first")

noparen <- function(x) gsub("\\)","",gsub("\\(","",x))
Expand Down Expand Up @@ -535,7 +537,7 @@ module_graph <- function(input_string, skip_minus=FALSE) {
}
tmp_g <- data.frame(tmpg) |> `colnames<-`(c("from","to","type"))
el <- simplify(graph_from_data_frame(tmpg, directed=FALSE),
edge.attr.comb = "first")
edge.attr.comb="first")
tmp_g <- data.frame(as_data_frame(el)) |>
`colnames<-`(c("from","to","type"))
list(tmp_g, css)
Expand Down Expand Up @@ -625,23 +627,21 @@ module_graph <- function(input_string, skip_minus=FALSE) {
if (!is.null(rels)) {
if (!is.null(cssparsed)) {
plotg <- simplify(graph_from_data_frame(rbind(all_g, cssparsed),
directed = FALSE),
edge.attr.comb = "first")
directed=FALSE),
edge.attr.comb="first")
} else {
plotg <- simplify(graph_from_data_frame(rbind(all_g),
directed = FALSE),
edge.attr.comb = "first")
directed=FALSE),
edge.attr.comb="first")
}
} else {
if (!is.null(cssparsed)) {
plotg <- simplify(graph_from_data_frame(rbind(cssparsed),
directed = FALSE),
edge.attr.comb = "first")
directed=FALSE),
edge.attr.comb="first")
} else {
plotg <- input_string
}
# plotg <- simplify(graph_from_data_frame(norel, directed = FALSE),edge.attr.comb = "first")
# plotg <- graph_from_data_frame(rbind(as_data_frame(plotg), reledges), directed=TRUE)
}
return(plotg)
}
Expand All @@ -663,16 +663,20 @@ parse_module <- function(kmo) {
right <- gsub(" ","", right)
Cpattern <- "C\\d{5}"
Rpattern <- "R\\d{5}"
left_Rmatches <- str_extract_all(left, Rpattern) |> unlist() |> tibble()
left_Cmatches <- str_extract_all(left, Cpattern) |> unlist() |> tibble()
right_Cmatches <- str_extract_all(right, Cpattern) |> unlist() |> tibble()
left_Rmatches <- str_extract_all(left, Rpattern) |>
unlist() |> tibble()
left_Cmatches <- str_extract_all(left, Cpattern) |>
unlist() |> tibble()
right_Cmatches <- str_extract_all(right, Cpattern) |>
unlist() |> tibble()

# left
## Reaction
left2 <- gsub(" ", "", unlist(strsplit(left, " "))[2])
left1 <- gsub(" ", "", unlist(strsplit(left, " "))[1])
if (is.na(left2)) {
message("Some modules cannot be parsed properly by the delimiter ' ', changing the split parameter")
message("Some modules cannot be parsed properly by the delimiter",
" ' ', changing the split parameter")
message(paste0(" ",left))
left2 <- gsub(" ", "", unlist(strsplit(left, " "))[2])
left1 <- gsub(" ", "", unlist(strsplit(left, " "))[1])
Expand All @@ -693,11 +697,14 @@ parse_module <- function(kmo) {
"each_reacs_raw"=c(left2, left1, right_raw |> gsub(" ","",x=_)),
"reac"=reac)
})
reac <- as_tibble(do.call(rbind, lapply(reac_list, function(x) x[["reac"]])))
reac <- as_tibble(do.call(rbind,
lapply(reac_list, function(x) x[["reac"]])))
if (dim(reac)[1] != 0) {
each <- as_tibble(do.call(rbind, lapply(reac_list, function(x) x[["each_reacs"]])))
each <- as_tibble(do.call(rbind,
lapply(reac_list, function(x) x[["each_reacs"]])))
names(each) <- c("left","reaction","right")
eachraw <- as_tibble(do.call(rbind, lapply(reac_list, function(x) x[["each_reacs_raw"]])))
eachraw <- as_tibble(do.call(rbind,
lapply(reac_list, function(x) x[["each_reacs_raw"]])))
names(eachraw) <- c("left","reaction","right")
reac <- reac |> data.frame() |> `colnames<-`(c("from","to","reaction"))
kmo@reaction_graph <- as_tbl_graph(reac)
Expand Down Expand Up @@ -772,14 +779,15 @@ parse_module <- function(kmo) {
#' @return numeric value
module_abundance <- function(mod_id, vec, num=1, calc="weighted_mean") {
mod <- module(mod_id)
ko_abun <- lapply(mod@definitions[[num]]$definition_ko_in_block, function(kos) {
if (length(intersect(kos, names(vec))) >= 1) {
mean_kos <- vec[intersect(kos, names(vec))] |> mean()
} else {
mean_kos <- 0
}
return(mean_kos)
}) |> unlist()
ko_abun <- lapply(mod@definitions[[num]]$definition_ko_in_block,
function(kos) {
if (length(intersect(kos, names(vec))) >= 1) {
mean_kos <- vec[intersect(kos, names(vec))] |> mean()
} else {
mean_kos <- 0
}
return(mean_kos)
}) |> unlist()

comp <- module_completeness(mod, names(vec))
comp$abundance <- ko_abun
Expand All @@ -802,7 +810,8 @@ module_abundance <- function(mod_id, vec, num=1, calc="weighted_mean") {
#' @export
pathway_abundance <- function(id, vec, num=1) {
pway <- pathway_info(id)
mods <- pway$MODULE |> strsplit(" ") |> vapply("[", 1, FUN.VALUE="character") |> unique()
mods <- pway$MODULE |> strsplit(" ") |>
vapply("[", 1, FUN.VALUE="character") |> unique()
abuns <- lapply(mods, function(mod) {
module_abundance(mod_id=mod, num=num, vec=vec)
}) |> unlist()
Expand All @@ -828,11 +837,16 @@ create_test_module <- function() {
mo@name <- "test module"
mo@reaction_each <- tibble(left=list("C00065"),reaction=list("R00586"),
right=list("C00979"))
mo@reaction_each_raw <- tibble(left="C00065",reaction="R00586",right="C00979")
mo@definition_raw <- list(c("(K00174+K00175,K00382) (K01902+K01903,K01899"))
mo@definitions <- list("1"=list("definition_block"=c("K00174+K00175,K00382","K01902+K01903,K01899"),
mo@reaction_each_raw <-
tibble(left="C00065",reaction="R00586",right="C00979")
mo@definition_raw <-
list(c("(K00174+K00175,K00382) (K01902+K01903,K01899"))
mo@definitions <-
list("1"=list("definition_block"=c("K00174+K00175,K00382",
"K01902+K01903,K01899"),
"definition_kos"=c("K00174","K00175","K00382","K01902","K01903","K01899"),
"definition_num_in_block"=c(3,3),
"definition_ko_in_block"=list(c("K00174","K00175","K00382"),c("K01902","K01903","K01899"))))
"definition_ko_in_block"=list(c("K00174","K00175","K00382"),
c("K01902","K01903","K01899"))))
mo
}
Loading

0 comments on commit 786ec0f

Please sign in to comment.