## ----style, eval=TRUE, echo=FALSE, results='asis'-------------------------- BiocStyle::latex() ## ----include=FALSE--------------------------------------------------------- library(knitr) opts_chunk$set(tidy=FALSE) ## ----Homo.sapiens---------------------------------------------------------- library(RSQLite) library(Homo.sapiens) columns(Homo.sapiens) ## ----Homo.sapiens2--------------------------------------------------------- keytypes(Homo.sapiens) ## ----Homo.sapiens3--------------------------------------------------------- k <- head(keys(Homo.sapiens,keytype="ENTREZID")) k ## ----Homo.sapiens4--------------------------------------------------------- result <- select(Homo.sapiens, keys=k, columns=c("TXNAME","TXSTART","TXSTRAND"), keytype="ENTREZID") head(result) ## ----BFC_manage,echo=FALSE------------------------------------------------- .get_file <- function(fullUri) { bfc <- BiocFileCache::BiocFileCache() BiocFileCache::bfcrpath( bfc, rname = fullUri, exact = TRUE, download = TRUE, rtype = "web" ) } ## ----URI Example----------------------------------------------------------- uri <- 'http://rest.uniprot.org/uniprotkb/search?query=' ids <- c('P13368', 'Q6GZX4') idStr <- paste(ids, collapse=utils::URLencode(" OR ")) format <- '&format=tsv' fullUri <- paste0(uri,idStr,format) uquery <- .get_file(fullUri) read.delim(uquery) ## ----web service code------------------------------------------------------ getUniprotGoodies <- function(query, columns) { ## query and columns start as a character vectors qstring <- paste(query, collapse="+or+") cstring <- paste(columns, collapse=",") uri <- 'http://www.uniprot.org/uniprot/?query=' fullUri <- paste0(uri,qstring,'&format=tab&columns=',cstring) dat <- read.delim(fullUri) ## now remove things that were not in the specific original query... dat <- dat[dat[,1] %in% query,] dat } ## ----xml_tree-------------------------------------------------------------- library(XML) uri <- "http://rest.uniprot.org/uniprotkb/search?query=P13368%20OR%20Q6GZX4&format=xml" fl <- tempfile() download.file(uri, fl) xml <- xmlTreeParse(fl, useInternalNodes=TRUE) ## ----xml_namespace--------------------------------------------------------- defs <- xmlNamespaceDefinitions(xml, recurisve=TRUE) defs ## ----xml_namespace_struct-------------------------------------------------- ns <- structure(sapply(defs, function(x) x$uri), names=names(defs)) ## ----xml_namespace2-------------------------------------------------------- entry <- getNodeSet(xml, "//ns:entry", "ns") xmlSize(entry) ## ----xml_xmlAttrs---------------------------------------------------------- nms <- xpathSApply(xml, "//ns:entry/ns:name", xmlValue, namespaces="ns") attrs <- xpathApply(xml, "//ns:entry", xmlAttrs, namespaces="ns") names(attrs) <- nms attrs ## ----xml_xmlChildren------------------------------------------------------- fun1 <- function(elt) unique(names(xmlChildren(elt))) xpathApply(xml, "//ns:entry", fun1, namespaces="ns") ## ----xml_feature_type------------------------------------------------------ Q6GZX4 <- "//ns:entry[ns:accession='Q6GZX4']/ns:feature" xmlSize(getNodeSet(xml, Q6GZX4, namespaces="ns")) P13368 <- "//ns:entry[ns:accession='P13368']/ns:feature" xmlSize(getNodeSet(xml, P13368, namespaces="ns")) ## ----xml_feature_type2----------------------------------------------------- path <- "//ns:feature" unique(xpathSApply(xml, path, xmlGetAttr, "type", namespaces="ns")) ## ----xml_feature_type_P13368----------------------------------------------- path <- "//ns:entry[ns:accession='P13368']/ns:feature[@type='sequence conflict']" data.frame(t(xpathSApply(xml, path, xmlAttrs, namespaces="ns"))) ## ----xml_sequence---------------------------------------------------------- library(Biostrings) path <- "//ns:entry/ns:sequence" seqs <- xpathSApply(xml, path, xmlValue, namespaces="ns") aa <- AAStringSet(unlist(lapply(seqs, function(elt) gsub("\n", "", elt)), use.names=FALSE)) names(aa) <- nms aa ## ----WebServiceObject------------------------------------------------------ setClass("uniprot", representation(name="character"), prototype(name="uniprot")) ## ----makeInstanceWebServiceObj--------------------------------------------- uniprot <- new("uniprot") ## ----onLoad2,eval=FALSE---------------------------------------------------- # .onLoad <- function(libname, pkgname) # { # ns <- asNamespace(pkgname) # uniprot <- new("uniprot") # assign("uniprot", uniprot, envir=ns) # namespaceExport(ns, "uniprot") # } ## ----keytypeUniprot-------------------------------------------------------- setMethod("keytypes", "uniprot",function(x){return("UNIPROT")}) uniprot <- new("uniprot") keytypes(uniprot) ## ----keytypeUniprot2------------------------------------------------------- setMethod("columns", "uniprot", function(x){return(c("ID", "SEQUENCE", "ORGANISM"))}) columns(uniprot) ## ----webServiceSelect------------------------------------------------------ .select <- function(x, keys, columns){ colsTranslate <- c(id='ID', sequence='SEQUENCE', organism='ORGANISM') columns <- names(colsTranslate)[colsTranslate %in% columns] getUniprotGoodies(query=keys, columns=columns) } setMethod("select", "uniprot", function(x, keys, columns, keytype) { .select(keys=keys, columns=columns) }) ## ----webServiceSelect2, eval=FALSE----------------------------------------- # select(uniprot, keys=c("P13368","P20806"), columns=c("ID","ORGANISM")) ## ----classicConn,results='hide'-------------------------------------------- drv <- SQLite() library("org.Hs.eg.db") con_hs <- dbConnect(drv, dbname=org.Hs.eg_dbfile()) con_hs ## ----ourConn2,eval=FALSE--------------------------------------------------- # org.Hs.eg.db$conn # ## or better we can use a helper function to wrap this: # AnnotationDbi::dbconn(org.Hs.eg.db) # ## or we can just call the provided convenience function # ## from when this package loads: # org.Hs.eg_dbconn() ## ----dbListTables---------------------------------------------------------- head(dbListTables(con_hs)) dbListFields(con_hs, "alias") ## ----dbGetQuery------------------------------------------------------------ dbGetQuery(con_hs, "SELECT * FROM metadata") ## ----dbListTables2--------------------------------------------------------- head(dbListTables(con_hs)) ## ----dbListFields2--------------------------------------------------------- dbListFields(con_hs, "chromosomes") ## ----dbGetQuery2----------------------------------------------------------- head(dbGetQuery(con_hs, "SELECT * FROM chromosomes")) ## ----Anopheles,eval=FALSE-------------------------------------------------- # head(dbGetQuery(con_hs, "SELECT * FROM chromosome_locations")) # ## Then only retrieve human records # ## Query: SELECT * FROM Anopheles_gambiae WHERE species='HOMSA' # head(dbGetQuery(con_hs, "SELECT * FROM chromosome_locations WHERE seqname='1'")) # dbDisconnect(con_hs) ## ----getMetadata, echo=FALSE----------------------------------------------- library(org.Hs.eg.db) org.Hs.eg_dbInfo() ## ----OrgDbClass,eval=FALSE------------------------------------------------- # showClass("OrgDb") ## ----onLoad,eval=FALSE----------------------------------------------------- # sPkgname <- sub(".db$","",pkgname) # db <- loadDb(system.file("extdata", paste(sPkgname, # ".sqlite",sep=""), package=pkgname, lib.loc=libname), # packageName=pkgname) # dbNewname <- AnnotationDbi:::dbObjectName(pkgname,"OrgDb") # ns <- asNamespace(pkgname) # assign(dbNewname, db, envir=ns) # namespaceExport(ns, dbNewname) ## ----columns,eval=FALSE---------------------------------------------------- # .cols <- function(x) # { # con <- AnnotationDbi::dbconn(x) # list <- dbListTables(con) # ## drop unwanted tables # unwanted <- c("map_counts","map_metadata","metadata") # list <- list[!list %in% unwanted] # # use on.exit to disconnect # # on.exit(dbDisconnect(con)) # ## Then just to format things in the usual way # toupper(list) # } # # ## Then make this into a method # setMethod("columns", "OrgDb", .cols(x)) # ## Then we can call it # columns(org.Hs.eg.db) ## ----keytypes,eval=FALSE--------------------------------------------------- # setMethod("keytypes", "OrgDb", function(x) .cols(x)) # ## Then we can call it # keytypes(org.Hs.eg.db) # # ## refactor of .cols # .getLCcolnames <- function(x) # { # con <- AnnotationDbi::dbconn(x) # list <- dbListTables(con) # ## drop unwanted tables # unwanted <- c("map_counts","map_metadata","metadata") # # use on.exit to disconnect # # on.exit(dbDisconnect(con)) # list[!list %in% unwanted] # } # .cols <- function(x) # { # list <- .getLCcolnames(x) # ## Then just to format things in the usual way # toupper(list) # } # ## Test: # columns(org.Hs.eg.db) # # ## new helper function: # .getTableNames <- function(x) # { # LC <- .getLCcolnames(x) # UC <- .cols(x) # names(UC) <- LC # UC # } # .getTableNames(org.Hs.eg.db) ## ----keys,eval=FALSE------------------------------------------------------- # .keys <- function(x, keytype) # { # ## translate keytype back to table name # tabNames <- .getTableNames(x) # lckeytype <- names(tabNames[tabNames %in% keytype]) # ## get a connection # con <- AnnotationDbi::dbconn(x) # sql <- paste("SELECT _id FROM", lckeytype, "WHERE species != 'HOMSA'") # res <- dbGetQuery(con, sql) # res <- as.vector(t(res)) # dbDisconnect(con) # res # } # # setMethod("keys", "ExampleDbClass", .keys) # ## Then we would call it # keys(example.db, "TRICHOPLAX_ADHAERENS") ## ----makeNewDb------------------------------------------------------------- drv <- dbDriver("SQLite") dbname <- file.path(tempdir(), "myNewDb.sqlite") con <- dbConnect(drv, dbname=dbname) ## ----exampleFrame---------------------------------------------------------- data <- data.frame(id=c(22,7,15), string=c("Blue", "Red", "Green")) ## ----exercise2------------------------------------------------------------- dbExecute(con, "CREATE Table genePheno (id INTEGER, string TEXT)") ## ----populate_SQL_table---------------------------------------------------- sql <- "INSERT INTO genePheno VALUES ($id, $string)" dbExecute(con, sql, params=data) ## ----dbReadTable----------------------------------------------------------- dbReadTable(con, "genePheno") ## ----ATTACH---------------------------------------------------------------- db <- system.file("extdata", "TxDb.Hsapiens.UCSC.hg19.knownGene.sqlite", package="TxDb.Hsapiens.UCSC.hg19.knownGene") dbExecute(con, sprintf("ATTACH '%s' AS db",db)) ## ----ATTACHJoin------------------------------------------------------------ sql <- "SELECT * FROM db.gene AS dbg, genePheno AS gp WHERE dbg.gene_id=gp.id" res <- dbGetQuery(con, sql) res ## ----dbDisconnect---------------------------------------------------------- dbDisconnect(con) ## ----sessionInfo----------------------------------------------------------- sessionInfo()