### R code from vignette source 'vignettes/AnnotationForge/inst/doc/MakingNewAnnotationPackages.Rnw'

###################################################
### code chunk number 1: Homo.sapiens
###################################################
library(Homo.sapiens)
cols(Homo.sapiens)


###################################################
### code chunk number 2: Homo.sapiens
###################################################
keytypes(Homo.sapiens) 


###################################################
### code chunk number 3: Homo.sapiens
###################################################
k <- head(keys(Homo.sapiens,keytype="ENTREZID"))
k


###################################################
### code chunk number 4: Homo.sapiens
###################################################
result <- select(Homo.sapiens, keys=k, 
                 cols=c("TXNAME","TXSTART","TXSTRAND"), 
                 keytype="ENTREZID")
head(result)


###################################################
### code chunk number 5: URI Example
###################################################
   uri <- 'http://www.uniprot.org/uniprot/?query='
   ids <- c('P13368', 'Q6GZX4')
   idStr <- paste(ids, collapse="+or+")
   format <- '&format=tab'
   fullUri <- paste0(uri,idStr,format)
   read.delim(fullUri)


###################################################
### code chunk number 6: web service code
###################################################
getUniprotGoodies  <- function(query, cols)
{
    ## query and cols start as a character vectors
    qstring <- paste(query, collapse="+or+")
    cstring <- paste(cols, collapse=",")
    uri <- 'http://www.uniprot.org/uniprot/?query='
    fullUri <- paste0(uri,qstring,'&format=tab&columns=',cstring)
    dat <- read.delim(fullUri, stringsAsFactors=FALSE)
    ## now remove things that were not in the specific original query...
    dat <- dat[dat[,1] %in% query,]
    dat
}


###################################################
### code chunk number 7: xml_tree
###################################################
library(XML)
uri <- "http://www.uniprot.org/uniprot/?query=P13368+or+Q6GZX4&format=xml"
xml <- xmlTreeParse(uri, useInternalNodes=TRUE)


###################################################
### code chunk number 8: xml_namespace
###################################################
defs <- xmlNamespaceDefinitions(xml, recurisve=TRUE)
defs


###################################################
### code chunk number 9: xml_namespace_struct
###################################################
ns <- structure(sapply(defs, function(x) x$uri), names=names(defs))


###################################################
### code chunk number 10: xml_namespace
###################################################
entry <- getNodeSet(xml, "//ns:entry", "ns")
xmlSize(entry)


###################################################
### code chunk number 11: xml_xmlAttrs
###################################################
nms <- xpathSApply(xml, "//ns:entry/ns:name", xmlValue, namespaces="ns")
attrs <- xpathApply(xml, "//ns:entry", xmlAttrs, namespaces="ns")
names(attrs) <- nms
attrs


###################################################
### code chunk number 12: xml_xmlChildren
###################################################
fun1 <- function(elt) unique(names(xmlChildren(elt)))
xpathApply(xml, "//ns:entry", fun1, namespaces="ns")


###################################################
### code chunk number 13: 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"))


###################################################
### code chunk number 14: xml_feature_type
###################################################
path <- "//ns:feature"
unique(xpathSApply(xml, path, xmlGetAttr, "type", namespaces="ns"))


###################################################
### code chunk number 15: xml_feature_type_P13368
###################################################
path <- "//ns:entry[ns:accession='P13368']/ns:feature[@type='sequence conflict']"
data.frame(t(xpathSApply(xml, path, xmlAttrs, namespaces="ns")))


###################################################
### code chunk number 16: 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


###################################################
### code chunk number 17: WebServiceObject
###################################################
setClass("uniprot", representation(name="character"),
         prototype(name="uniprot"))


###################################################
### code chunk number 18: makeInstanceWebServiceObj
###################################################
    uniprot <- new("uniprot")


###################################################
### code chunk number 19: onLoad2 (eval = FALSE)
###################################################
## .onLoad <- function(libname, pkgname)
## {
##     ns <- asNamespace(pkgname)
##     uniprot <- new("uniprot")
##     assign("uniprot", uniprot, envir=ns)
##     namespaceExport(ns, "uniprot")
## }


###################################################
### code chunk number 20: keytypeUniprot
###################################################
setMethod("keytypes", "uniprot",function(x){return("UNIPROT")})
uniprot <- new("uniprot")
keytypes(uniprot)


###################################################
### code chunk number 21: keytypeUniprot
###################################################
setMethod("cols", "uniprot", 
          function(x){return(c("ID", "SEQUENCE", "ORGANISM"))})
cols(uniprot)


###################################################
### code chunk number 22: webServiceSelect
###################################################
.select <- function(x, keys, cols){
    colsTranslate <- c(id='ID', sequence='SEQUENCE', organism='ORGANISM')
    cols <- names(colsTranslate)[colsTranslate %in% cols]
    getUniprotGoodies(query=keys, cols=cols)
}
setMethod("select", "uniprot", 
    function(x, keys, cols, keytype)
{
    .select(keys=keys, cols=cols)
})
select(uniprot, keys=c("P13368","P20806"), cols=c("ID","ORGANISM"))


###################################################
### code chunk number 23: classicConn
###################################################
drv <- SQLite()
library("org.Hs.eg.db")
con <- dbConnect(drv, dbname=system.file("extdata", "org.Hs.eg.sqlite",
                        package = "org.Hs.eg.db"))
con
dbDisconnect(con)


###################################################
### code chunk number 24: ourConn
###################################################
require(hom.Hs.inp.db)
str(hom.Hs.inp.db)


###################################################
### code chunk number 25: ourConn2
###################################################
hom.Hs.inp.db$conn
## or better we can use a helper function to wrap this:
AnnotationDbi:::dbConn(hom.Hs.inp.db)
## or we can just call the provided convenience function 
## from when this package loads:
hom.Hs.inp_dbconn()


###################################################
### code chunk number 26: dbListTables
###################################################
con <- AnnotationDbi:::dbConn(hom.Hs.inp.db)
head(dbListTables(con))
dbListFields(con, "Mus_musculus")


###################################################
### code chunk number 27: dbGetQuery
###################################################
dbGetQuery(con, "SELECT * FROM metadata")


###################################################
### code chunk number 28: dbListTables2
###################################################
head(dbListTables(con))


###################################################
### code chunk number 29: dbListFields2
###################################################
dbListFields(con, "Apis_mellifera")


###################################################
### code chunk number 30: dbGetQuery2
###################################################
head(dbGetQuery(con, "SELECT * FROM Apis_mellifera"))


###################################################
### code chunk number 31: Anopheles (eval = FALSE)
###################################################
## head(dbGetQuery(con, "SELECT * FROM Anopheles_gambiae"))
## ## Then only retrieve human records
## ## Query: SELECT * FROM Anopheles_gambiae WHERE species='HOMSA'
## head(dbGetQuery(con, "SELECT * FROM Anopheles_gambiae WHERE species='HOMSA'"))
## dbDisconnect(con)


###################################################
### code chunk number 32: getMetadata
###################################################
library(hom.Hs.inp.db)
hom.Hs.inp_dbInfo()


###################################################
### code chunk number 33: referenceClass (eval = FALSE)
###################################################
## .InparanoidDb <-
##     setRefClass("InparanoidDb", contains="AnnotationDb")


###################################################
### code chunk number 34: 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,"InparanoidDb")
## ns <- asNamespace(pkgname)
## assign(dbNewname, db, envir=ns)
## namespaceExport(ns, dbNewname)


###################################################
### code chunk number 35: cols (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]
##     ## Then just to format things in the usual way
##     list <- toupper(list)
##     dbDisconnect(con)
##     list
## }
## 
## ## Then make this into a method
## setMethod("cols", "InparanoidDb", .cols(x))
## ## Then we can call it
## cols(hom.Hs.inp.db)


###################################################
### code chunk number 36: keytypes (eval = FALSE)
###################################################
## setMethod("keytypes", "InparanoidDb", .cols(x))
## ## Then we can call it
## keytypes(hom.Hs.inp.db)
## 
## ## refactor of .cols
## .getLCcolnames <- function(x)
## {
##     con <- AnnotationDbi:::dbConn(x)
##     list <- dbListTables(con)
##     ## drop unwanted tables
##     unwanted <- c("map_counts","map_metadata","metadata")
##     list <- list[!list %in% unwanted]
##     dbDisconnect(con)
##     list
## }
## .cols <- function(x)
## {
##     list <- .getLCcolnames(x)
##     ## Then just to format things in the usual way
##     toupper(list)
## }
## ## Test:
## cols(hom.Hs.inp.db)
## 
## ## new helper function:
## .getTableNames <- function(x)
## {
##     LC <- .getLCcolnames(x)
##     UC <- .cols(x)
##     names(UC) <- LC
##     UC
## }
## .getTableNames(hom.Hs.inp.db)


###################################################
### code chunk number 37: 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 inp_id FROM",lckeytype, "WHERE species!='HOMSA'")
##     res <- dbGetQuery(con, sql)
##     res <- as.vector(t(res))
##     dbDisconnect(con)
##     res
## }
## 
## setMethod("keys", "InparanoidDb", .keys(x, keytype))
## ## Then we can call it
## keys(hom.Hs.inp.db, "TRICHOPLAX_ADHAERENS")


###################################################
### code chunk number 38: dbDisconnect
###################################################
   dbDisconnect(con)


###################################################
### code chunk number 39: makeNewDb
###################################################
drv <- dbDriver("SQLite")
dbname <- file.path(tempdir(), "myNewDb.sqlite")
con <- dbConnect(drv, dbname=dbname)


###################################################
### code chunk number 40: exampleFrame
###################################################
data = data.frame(id=c(1,2,9),
                  string=c("Blue",
                           "Red",
                           "Green"),
                  stringsAsFactors=FALSE)


###################################################
### code chunk number 41: exercise2
###################################################
dbGetQuery(con, "CREATE Table genePheno (id INTEGER, string TEXT)")


###################################################
### code chunk number 42: LabelledPreparedQueries
###################################################
names(data) <- c("id","string")
sql <- "INSERT INTO genePheno VALUES ($id, $string)"
dbBeginTransaction(con)
dbGetPreparedQuery(con, sql, bind.data = data)
dbCommit(con)


###################################################
### code chunk number 43: ATTACH
###################################################
db <- system.file("extdata", "TxDb.Hsapiens.UCSC.hg19.knownGene.sqlite", 
                  package="TxDb.Hsapiens.UCSC.hg19.knownGene")
dbGetQuery(con, sprintf("ATTACH '%s' AS db",db))


###################################################
### code chunk number 44: ATTACHJoin
###################################################
  sql <- "SELECT * FROM db.gene AS dbg, 
          genePheno AS gp WHERE dbg.gene_id=gp.id"
  res <- dbGetQuery(con, sql)
  res


###################################################
### code chunk number 45: SessionInfo
###################################################
sessionInfo()