# HG changeset patch # User proteore # Date 1621254582 0 # Node ID f4e32dee3b286f011531c26bd20a07664d1e598f # Parent 86d2f0377e69634db741623e06d67593a4b3c4c9 "planemo upload commit 151e7b469b231bbc43c4c39e8e836b05ab6d2253-dirty" diff -r 86d2f0377e69 -r f4e32dee3b28 kegg_identification.R --- a/kegg_identification.R Fri Jan 24 10:46:35 2020 -0500 +++ b/kegg_identification.R Mon May 17 12:29:42 2021 +0000 @@ -1,19 +1,19 @@ -options(warn=-1) #TURN OFF WARNINGS !!!!!! +options(warn = -1) #TURN OFF WARNINGS !!!!!! suppressMessages(library(KEGGREST)) -get_args <- function(){ - +get_args <- function() { + ## Collect arguments args <- commandArgs(TRUE) - + ## Default setting when no arguments passed - if(length(args) < 1) { + if (length(args) < 1) { args <- c("--help") } - + ## Help section - if("--help" %in% args) { + if ("--help" %in% args) { cat("Pathview R script Arguments: --help Print this test @@ -24,180 +24,201 @@ --nb_pathways number of pathways to return --header boolean --output output path - --species species used to get specific pathways (hsa,mmu,rno) + --species species used to get specific pathways(hsa,mmu,rno) Example: - Rscript keggrest.R --input='P31946,P62258' --id_type='uniprot' --id_column 'c1' --header TRUE \n\n") - - q(save="no") + Rscript keggrest.R --input='P31946,P62258' --id_type='uniprot' + --id_column 'c1' --header TRUE \n\n") + + q(save = "no") } - - parseArgs <- function(x) strsplit(sub("^--", "", x), "=") - argsDF <- as.data.frame(do.call("rbind", parseArgs(args))) - args <- as.list(as.character(argsDF$V2)) - names(args) <- argsDF$V1 - + + parseargs <- function(x) strsplit(sub("^--", "", x), "=") + argsdf <- as.data.frame(do.call("rbind", parseargs(args))) + args <- as.list(as.character(argsdf$V2)) + names(args) <- argsdf$V1 + return(args) } -str2bool <- function(x){ - if (any(is.element(c("t","true"),tolower(x)))){ - return (TRUE) - }else if (any(is.element(c("f","false"),tolower(x)))){ - return (FALSE) - }else{ +str2bool <- function(x) { + if (any(is.element(c("t", "true"), tolower(x)))) { + return(TRUE) + }else if (any(is.element(c("f", "false"), tolower(x)))) { + return(FALSE) + }else { return(NULL) } } -read_file <- function(path,header){ - file <- try(read.csv(path,header=header, sep="\t",stringsAsFactors = FALSE, quote="\"", check.names = F),silent=TRUE) - if (inherits(file,"try-error")){ +read_file <- function(path, header) { + file <- try(read.csv(path, header = header, sep = "\t", + stringsAsFactors = FALSE, quote = "\"", check.names = F), silent = TRUE) + if (inherits(file, "try-error")) { stop("File not found !") - }else{ + }else { return(file) } } -get_pathways_list <- function(species){ +get_pathways_list <- function(species) { ##all available pathways for the species - pathways <-keggLink("pathway", species) - tot_path<-unique(pathways) - + pathways <- keggLink("pathway", species) + tot_path <- unique(pathways) + ##formating the dat into a list object ##key= pathway ID, value = genes of the pathway in the kegg format - pathways_list <- sapply(tot_path, function(pathway) names(which(pathways==pathway))) - return (pathways_list) + pathways_list <- sapply(tot_path, function(pathway) + names(which(pathways == pathway))) + return(pathways_list) } -get_list_from_cp <-function(list){ - list = strsplit(list, "[ \t\n]+")[[1]] - list = gsub("[[:blank:]]|\u00A0|NA","",list) - list = list[which(!is.na(list[list != ""]))] #remove empty entry - list = unique(gsub("-.+", "", list)) #Remove isoform accession number (e.g. "-2") +get_list_from_cp <- function(list) { + list <- strsplit(list, "[ \t\n]+")[[1]] + list <- gsub("[[:blank:]]|\u00A0|NA", "", list) + list <- list[which(!is.na(list[list != ""]))] #remove empty entry + list <- unique(gsub("-.+", "", list)) + #Remove isoform accession number (e.g. "-2") return(list) } -geneID_to_kegg <- function(vector,species){ - vector <- sapply(vector, function(x) paste(species,x,sep=":"),USE.NAMES = F) - return (vector) +geneid_to_kegg <- function(vector, species) { + vector <- sapply(vector, function(x) paste(species, x, sep = ":"), + USE.NAMES = F) + return(vector) } -to_keggID <- function(id_list,id_type){ - if (id_type == "ncbi-geneid") { - id_list <- unique(geneID_to_kegg(id_list,args$species)) - } else if (id_type=="uniprot"){ - id_list <- unique(sapply(id_list, function(x) paste(id_type,":",x,sep=""),USE.NAMES = F)) - if (length(id_list)>250){ - id_list <- split(id_list, ceiling(seq_along(id_list)/250)) - id_list <- sapply(id_list, function(x) keggConv("genes",x)) +to_keggid <- function(id_list, id_type) { + if (id_type == "ncbi-geneid") { + id_list <- unique(geneid_to_kegg(id_list, args$species)) + }else if (id_type == "uniprot") { + id_list <- unique(sapply(id_list, function(x) + paste(id_type, ":", x, sep = ""), USE.NAMES = F)) + if (length(id_list) > 250) { + id_list <- split(id_list, ceiling(seq_along(id_list) / 250)) + id_list <- sapply(id_list, function(x) keggConv("genes", x)) id_list <- unique(unlist(id_list)) } else { id_list <- unique(keggConv("genes", id_list)) } - } else if (id_type=="kegg-id") { + } else if (id_type == "kegg-id") { id_list <- unique(id_list) } - return (id_list) + return(id_list) } #take data frame, return data frame -split_ids_per_line <- function(line,ncol){ - +split_ids_per_line <- function(line, ncol) { + #print (line) - header = colnames(line) - line[ncol] = gsub("[[:blank:]]|\u00A0","",line[ncol]) - - if (length(unlist(strsplit(as.character(line[ncol]),";")))>1) { - if (length(line)==1 ) { - lines = as.data.frame(unlist(strsplit(as.character(line[ncol]),";")),stringsAsFactors = F) + header <- colnames(line) + line[ncol] <- gsub("[[:blank:]]|\u00A0", "", line[ncol]) + + if (length(unlist(strsplit(as.character(line[ncol]), ";"))) > 1) { + if (length(line) == 1) { + lines <- as.data.frame(unlist(strsplit( + as.character(line[ncol]), ";")), stringsAsFactors = F) } else { - if (ncol==1) { #first column - lines = suppressWarnings(cbind(unlist(strsplit(as.character(line[ncol]),";")), line[2:length(line)])) - } else if (ncol==length(line)) { #last column - lines = suppressWarnings(cbind(line[1:ncol-1],unlist(strsplit(as.character(line[ncol]),";")))) + if (ncol == 1) { #first column + lines <- suppressWarnings(cbind(unlist(strsplit( + as.character(line[ncol]), ";")), line[2:length(line)])) + } else if (ncol == length(line)) { #last column + lines <- suppressWarnings(cbind(line[1:ncol - 1], + unlist(strsplit(as.character(line[ncol]), ";")))) } else { - lines = suppressWarnings(cbind(line[1:ncol-1], unlist(strsplit(as.character(line[ncol]),";"),use.names = F), line[(ncol+1):length(line)])) + lines <- suppressWarnings(cbind(line[1:ncol - 1], + unlist(strsplit(as.character(line[ncol]), ";"), use.names = F), + line[(ncol + 1):length(line)])) } } - colnames(lines)=header + colnames(lines) <- header return(lines) } else { return(line) } } -#create new lines if there's more than one id per cell in the columns in order to have only one id per line -one_id_one_line <-function(tab,ncol){ - - if (ncol(tab)>1){ - - tab[,ncol] = sapply(tab[,ncol],function(x) gsub("[[:blank:]]","",x)) - header=colnames(tab) - res=as.data.frame(matrix(ncol=ncol(tab),nrow=0)) - for (i in 1:nrow(tab) ) { - lines = split_ids_per_line(tab[i,],ncol) - res = rbind(res,lines) +#create new lines if there's more than one id per cell in the columns in order +#to have only one id per line +one_id_one_line <- function(tab, ncol) { + + if (ncol(tab) > 1) { + + tab[, ncol] <- sapply(tab[, ncol], function(x) gsub("[[:blank:]]", "", x)) + header <- colnames(tab) + res <- as.data.frame(matrix(ncol = ncol(tab), nrow = 0)) + for (i in seq_len(nrow(tab))) { + lines <- split_ids_per_line(tab[i, ], ncol) + res <- rbind(res, lines) } - }else { - res = unlist(sapply(tab[,1],function(x) strsplit(x,";")),use.names = F) - res = data.frame(res[which(!is.na(res[res!=""]))],stringsAsFactors = F) - colnames(res)=colnames(tab) + } else { + res <- unlist(sapply(tab[, 1], function(x) strsplit(x, ";")), use.names = F) + res <- data.frame(res[which(!is.na(res[res != ""]))], stringsAsFactors = F) + colnames(res) <- colnames(tab) } return(res) } -kegg_mapping<- function(kegg_id_list,id_type,ref_ids) { - +kegg_mapping <- function(kegg_id_list, id_type, ref_ids) { + #mapping - map<-lapply(ref_ids, is.element, unique(kegg_id_list)) - names(map) <- sapply(names(map), function(x) gsub("path:","",x),USE.NAMES = FALSE) #remove the prefix "path:" - - in.path<-sapply(map, function(x) length(which(x==TRUE))) - tot.path<-sapply(map, length) - - ratio <- (as.numeric(in.path[which(in.path!=0)])) / (as.numeric(tot.path[which(in.path!=0)])) - ratio <- as.numeric(format(round(ratio*100, 2), nsmall = 2)) - + map <- lapply(ref_ids, is.element, unique(kegg_id_list)) + names(map) <- sapply(names(map), function(x) gsub("path:", "", x), + USE.NAMES = FALSE) #remove the prefix "path:" + + in_path <- sapply(map, function(x) length(which(x == TRUE))) + tot_path <- sapply(map, length) + + ratio <- (as.numeric(in_path[which(in_path != 0)])) / + (as.numeric(tot_path[which(in_path != 0)])) + ratio <- as.numeric(format(round(ratio * 100, 2), nsmall = 2)) + ##useful but LONG ## to do before : in step 1 - path.names<-names(in.path[which(in.path!=0)]) - name <- sapply(path.names, function(x) keggGet(x)[[1]]$NAME,USE.NAMES = FALSE) - - res<-data.frame(I(names(in.path[which(in.path!=0)])), I(name), ratio, as.numeric(in.path[which(in.path!=0)]), as.numeric(tot.path[which(in.path!=0)])) - res <- res[order(as.numeric(res[,3]),decreasing = TRUE),] - colnames(res)<-c("pathway_ID", "Description" , "Ratio IDs mapped/total IDs (%)" ,"nb KEGG genes IDs mapped in the pathway", "nb total of KEGG genes IDs present in the pathway") - + path_names <- names(in_path[which(in_path != 0)]) + name <- sapply(path_names, function(x) keggGet(x)[[1]]$NAME, + USE.NAMES = FALSE) + + res <- data.frame(I(names(in_path[which(in_path != 0)])), I(name), ratio, + as.numeric(in_path[which(in_path != 0)]), + as.numeric(tot_path[which(in_path != 0)])) + res <- res[order(as.numeric(res[, 3]), decreasing = TRUE), ] + colnames(res) <- c("pathway_ID", "Description", + "Ratio IDs mapped / total IDs (%)", + "nb KEGG genes IDs mapped in the pathway", + "nb total of KEGG genes IDs present in the pathway") + return(res) - + } #get args from command line args <- get_args() -#save(args,file="/home/dchristiany/proteore_project/ProteoRE/tools/kegg_identification/args.Rda") -#load("/home/dchristiany/proteore_project/ProteoRE/tools/kegg_identification/args.Rda") - ###setting variables -header = str2bool(args$header) -if (!is.null(args$id_list)) {id_list <- get_list_from_cp(args$id_list)} #get ids from copy/paste input -if (!is.null(args$input)) { #get ids from input file - csv <- read_file(args$input,header) - ncol <- as.numeric(gsub("c", "" ,args$id_column)) - csv <- one_id_one_line(csv,ncol) - id_list <- as.vector(csv[,ncol]) - id_list <- unique(id_list[which(!is.na(id_list[id_list!=""]))]) +header <- str2bool(args$header) +if (!is.null(args$id_list)) { + id_list <- get_list_from_cp(args$id_list) + } #get ids from copy/paste input +if (!is.null(args$input)) { #get ids from input file + csv <- read_file(args$input, header) + ncol <- as.numeric(gsub("c", "", args$id_column)) + csv <- one_id_one_line(csv, ncol) + id_list <- as.vector(csv[, ncol]) + id_list <- unique(id_list[which(!is.na(id_list[id_list != ""]))]) } #convert to keggID if needed -id_list <- to_keggID(id_list,args$id_type) +id_list <- to_keggid(id_list, args$id_type) #get pathways of species with associated KEGG ID genes pathways_list <- get_pathways_list(args$species) #mapping on pathways -res <- kegg_mapping(id_list,args$id_type,pathways_list) -if (nrow(res) > as.numeric(args$nb_pathways)) { res <- res[1:args$nb_pathways,] } +res <- kegg_mapping(id_list, args$id_type, pathways_list) +if (nrow(res) > as.numeric(args$nb_pathways)) { + res <- res[1:args$nb_pathways, ] + } -write.table(res, file=args$output, quote=FALSE, sep='\t',row.names = FALSE, col.names = TRUE) - +write.table(res, file = args$output, quote = FALSE, sep = "\t", + row.names = FALSE, col.names = TRUE) diff -r 86d2f0377e69 -r f4e32dee3b28 kegg_identification.xml --- a/kegg_identification.xml Fri Jan 24 10:46:35 2020 -0500 +++ b/kegg_identification.xml Mon May 17 12:29:42 2021 +0000 @@ -1,4 +1,4 @@ - + [PathView] bioconductor-keggrest