ydeng/bch441-work-abc-units
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use requireNamespace(), <package>::<function>() idiom,

Browse Source 
Biocmanager:: - not biocLite()
This commit is contained in:
hyginn
2019-01-08 17:11:25 +10:00
parent 8cdbb9f4cc
commit cffd803c23
30 changed files with 1185 additions and 1069 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
scripts/ABC-dbUtilities.R
View File

@@ -9,21 +9,18 @@
# ====== PACKAGES ==============================================================
if (! require(jsonlite, quietly = TRUE)) {
if (! requireNamespace("jsonlite", quietly = TRUE)) {
install.packages("jsonlite")
library(jsonlite)
}
if (! require(httr, quietly = TRUE)) {
if (! requireNamespace("httr", quietly = TRUE)) {
install.packages("httr")
library(httr)
}
if (! require(xml2, quietly = TRUE)) {
if (! requireNamespace("xml2", quietly = TRUE)) {
install.packages("xml2")
library(xml2)
}
@@ -226,10 +223,10 @@ dbFetchUniProtSeq <- function(ID) {
URL <- sprintf("http://www.uniprot.org/uniprot/%s.fasta", ID)
response <- GET(URL)
response <- httr::GET(URL)
mySeq <- character()
if (status_code(response) == 200) {
if (httr::status_code(response) == 200) {
x <- as.character(response)
x <- strsplit(x, "\n")
mySeq <- dbSanitizeSequence(x)
@@ -253,17 +250,17 @@ dbFetchPrositeFeatures <- function(ID) {
URL <- "https://prosite.expasy.org/cgi-bin/prosite/PSScan.cgi"
response <- POST(URL,
body = list(meta = "opt1",
meta1_protein = "opt1",
seq = ID,
skip = "on",
output = "tabular"))
response <- httr::POST(URL,
body = list(meta = "opt1",
meta1_protein = "opt1",
seq = ID,
skip = "on",
output = "tabular"))
myFeatures <- data.frame()
if (status_code(response) == 200) {
if (httr::status_code(response) == 200) {
lines <- unlist(strsplit(content(response, "text"), "\\n"))
lines <- unlist(strsplit(httr::content(response, "text"), "\\n"))
patt <- sprintf("\\|%s\\|", UniProtID)
lines <- lines[grep(patt, lines)]
@@ -289,8 +286,8 @@ node2text <- function(doc, tag) {
# Contents of all matching elements is returned in
# a vector of strings.
path <- paste0("//", tag)
nodes <- xml_find_all(doc, path)
return(xml_text(nodes))
nodes <- xml2::xml_find_all(doc, path)
return(xml2::xml_text(nodes))
}
@@ -309,7 +306,7 @@ dbFetchNCBItaxData <- function(ID) {
"db=protein",
"&term=", ID,
sep="")
myXML <- read_xml(URL)
myXML <- xml2::read_xml(URL)
GID <- node2text(myXML, "Id")
URL <- paste0(eUtilsBase,
@@ -318,7 +315,7 @@ dbFetchNCBItaxData <- function(ID) {
"&id=",
GID,
"&version=2.0")
myXML <- read_xml(URL)
myXML <- xml2::read_xml(URL)
x <- as.integer(node2text(myXML, "TaxId"))
y <- node2text(myXML, "Organism")
@@ -346,14 +343,14 @@ UniProtIDmap <- function (s, mapFrom = "P_REFSEQ_AC", mapTo = "ACC") {
# for IDs that are not mapped.
URL <- "https://www.uniprot.org/uploadlists/"
response <- POST(URL,
body = list(from = mapFrom,
to = mapTo,
format = "tab",
query = s))
response <- httr::POST(URL,
body = list(from = mapFrom,
to = mapTo,
format = "tab",
query = s))
if (status_code(response) == 200) { # 200: oK
myMap <- read.delim(file = textConnection(content(response)),
if (httr::status_code(response) == 200) { # 200: oK
myMap <- read.delim(file = textConnection(httr::content(response)),
sep = "\t",
stringsAsFactors = FALSE)
myMap <- myMap[ , c(1,3)]
@@ -362,12 +359,23 @@ UniProtIDmap <- function (s, mapFrom = "P_REFSEQ_AC", mapTo = "ACC") {
myMap <- data.frame()
warning(paste("No uniProt ID mapping returned:",
"server sent status",
status_code(response)))
httr::status_code(response)))
}
return(myMap)
}
# ====== TESTS =================================================================
if (FALSE) {
if (! requireNamespace("testthat", quietly = TRUE)) {
install.packages("testthat")
}
# ToDo: test everything here
}
# [END]

51
scripts/ABC-makeMYSPElist.R
View File

@@ -3,14 +3,16 @@
# Purpose: Create a list of genome sequenced fungi with protein annotations and
# Mbp1 homologues.
#
# Version: 1.1.2
# Version: 1.2
#
# Date: 2016 09 - 2017 09
# Date: 2016 09 - 2019 01
# Author: Boris Steipe (boris.steipe@utoronto.ca)
#
# V 1.1.2 Moved BLAST.R to ./scripts directory
# V 1.1 Update 2017
# V 1.0 First code 2016
# Versions
# 1.2 Change from require() to requireNamespace()
# 1.1.2 Moved BLAST.R to ./scripts directory
# 1.1 Update 2017
# 1.0 First code 2016
#
# TODO:
#
@@ -31,27 +33,25 @@
# the respective intermediate results.
#
#TOC> ==========================================================================
#TOC>
#TOC> Section Title Line
#TOC> ---------------------------------------------------
#TOC> 1 The strategy 54
#TOC> 2 GOLD species 66
#TOC> 2.1 Initialize 71
#TOC> 2.2 Import 77
#TOC> 2.3 Unique species 129
#TOC> 3 BLAST species 171
#TOC> 3.1 find homologous proteins 178
#TOC> 3.2 Identify species in "hits" 202
#TOC> 4 Intersect GOLD and BLAST species 247
#TOC> 5 Cleanup and finish 265
#TOC>
#TOC>
#TOC> Section Title Line
#TOC> ---------------------------------------------------------
#TOC> 1 The strategy 55
#TOC> 2 GOLD species 67
#TOC> 2.1 Initialize 72
#TOC> 2.2 Import 79
#TOC> 2.3 Unique species 131
#TOC> 3 BLAST species 173
#TOC> 3.1 find homologous proteins 180
#TOC> 3.2 Identify species in "hits" 204
#TOC> 4 Intersect GOLD and BLAST species 249
#TOC> 5 Cleanup and finish 267
#TOC>
#TOC> ==========================================================================
#TOC>
#TOC>
# = 1 The strategy ========================================================
# This script will create a list of "MYSPE" species and save it in an R object
@@ -70,9 +70,10 @@
# (https://gold.jgi.doe.gov/). Use the data that is hosted at the NCBI.
# == 2.1 Initialize ========================================================
if (! require(httr)) { # httr provides interfaces to Webservers on the Internet
install.packages("httr")
library(httr)
# httr provides interfaces to Webservers on the Internet
if (! requireNamespace("httr", quietly = TRUE)) {
install.packages("httr")
}
# == 2.2 Import ============================================================

28
scripts/ABC-makeScCCnet.R
View File

@@ -15,12 +15,14 @@
# Data: (3 mb) https://downloads.yeastgenome.org/curation/literature/go_slim_mapping.tab
#
#
# Version: 1.0
# Version: 1.1
#
# Date: 2017 10 06
# Date: 2017 10 - 2019 01
# Author: Boris Steipe (boris.steipe@utoronto.ca)
#
# Versions:
# 1.1 Change from require() to requireNamespace(),
# use <package>::<function>() idiom throughout
# 1.0 First code copied from 2016 material.
#
# TODO:
@@ -28,16 +30,16 @@
#
# ==============================================================================
if (! require(readr, quietly = TRUE)) {
if (! requireNamespace("readr", quietly = TRUE)) {
install.packages("readr")
library(readr)
}
# STRING functional interaction data
# Read STRING Data (needs to be downloaded from database, see URL in Notes)
STR <- read_delim("./data/4932.protein.links.full.v10.5.txt", delim = " ")
STR <- readr::read_delim("./data/4932.protein.links.full.v10.5.txt",
delim = " ")
# Subset only IDs and combined_score column
STR <- STR[ , c("protein1", "protein2", "combined_score")]
@@ -61,14 +63,14 @@ myIntxGenes <- unique(c(STR$protein1, STR$protein2)) # yeast systematic gene
#
# Read GOSlim data (needs to be downloaded from database, see URL in Notes)
Gsl <- read_tsv("./data/go_slim_mapping.tab",
col_names = c("ID",
"name",
"SGDId",
"Ontology",
"termName",
"termID",
"status"))
Gsl <- readr::read_tsv("./data/go_slim_mapping.tab",
col_names = c("ID",
"name",
"SGDId",
"Ontology",
"termName",
"termID",
"status"))
# head(Gsl)
#

35
scripts/BLAST.R
View File

@@ -7,11 +7,13 @@
# https://ncbi.github.io/blast-cloud/dev/api.html
#
#
# Version: 3
# Date: 2016 09 - 2017 11
# Version: 3.1
# Date: 2016 09 - 2019 01
# Author: Boris Steipe
#
# Versions:
# 3.1 Change from require() to requireNamespace(),
# use <package>::<function>() idiom throughout
# 3 parsing logic had not been fully implemented; Fixed.
# 2.1 bugfix in BLAST(), bug was blanking non-split deflines;
# refactored parseBLASTalignment() to handle lists with multiple hits.
@@ -29,9 +31,8 @@
# ==============================================================================
if (! require(httr, quietly = TRUE)) {
if (! requireNamespace(httr, quietly = TRUE)) {
install.packages("httr")
library(httr)
}
@@ -92,13 +93,13 @@ BLAST <- function(q,
}
# send it off ...
response <- GET(results$query)
if (http_status(response)$category != "Success" ) {
response <- httr::GET(results$query)
if (httr::http_status(response)$category != "Success" ) {
stop(sprintf("PANIC: Can't send query. BLAST server status error: %s",
http_status(response)$message))
httr::http_status(response)$message))
}
txt <- content(response, "text", encoding = "UTF-8")
txt <- httr::content(response, "text", encoding = "UTF-8")
patt <- "RID = (\\w+)" # match the request id
results$rid <- regmatches(txt, regexec(patt, txt))[[1]][2]
@@ -127,13 +128,13 @@ BLAST <- function(q,
while (TRUE) {
# Check whether the result is ready
response <- GET(checkStatus)
if (http_status(response)$category != "Success" ) {
response <- httr::GET(checkStatus)
if (httr::http_status(response)$category != "Success" ) {
stop(sprintf("PANIC: Can't check status. BLAST server status error: %s",
http_status(response)$message))
httr::http_status(response)$message))
}
txt <- content(response, "text", encoding = "UTF-8")
txt <- httr::content(response, "text", encoding = "UTF-8")
if (length(grep("Status=WAITING", txt)) > 0) {
myTimeout <- myTimeout - EXTRAWAIT
@@ -184,13 +185,13 @@ BLAST <- function(q,
"&FORMAT_TYPE=Text",
sep = "")
response <- GET(retrieve)
if (http_status(response)$category != "Success" ) {
response <- httr::GET(retrieve)
if (httr::http_status(response)$category != "Success" ) {
stop(sprintf("PANIC: Can't retrieve. BLAST server status error: %s",
http_status(response)$message))
httr::http_status(response)$message))
}
txt <- content(response, "text", encoding = "UTF-8")
txt <- httr::content(response, "text", encoding = "UTF-8")
# txt contains the whole set of results. Process:
@@ -357,7 +358,7 @@ parseBLASTalignment <- function(hit) {
# ==== TESTS ===================================================================
# define query:
# q <- paste("IYSARYSGVDVYEFIHSTGSIMKRKKDDWVNATHI", # Mbp1 APSES domain sequence
# q <- paste("IYSARYSGVDVYEFIHSTGSIMKRKKDDWVNATHI", # Mbp1 APSES domain
# "LKAANFAKAKRTRILEKEVLKETHEKVQGGFGKYQ",
# "GTWVPLNIAKQLAEKFSVYDQLKPLFDFTQTDGSASP",
# sep="")