1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
### ========================================================================
### PROVEANDb methods
### =========================================================================
setMethod("keys", "PROVEANDb",
function(x, keytype, ...)
{
if (missing(keytype))
keytype <- "DBSNPID"
sql <- paste("SELECT DISTINCT ", keytype, " FROM proveandata ", sep="")
dbGetQuery(x$conn, sql)[,1]
}
)
setMethod("columns", "PROVEANDb",
function(x)
DBI:::dbListFields(x$conn, "proveandata")
)
setMethod("keytypes", "PROVEANDb",
function(x) "DBSNPID"
)
setMethod("select", "PROVEANDb",
function(x, keys, columns, keytype, ...)
{
if (missing(keytype)) keytype <- "DBSNPID"
sql <- .createPROVEANDbQuery(x, keys, columns, keytype)
if (length(sql)) {
raw <- dbGetQuery(x$conn, sql)
.formatPROVEANDbSelect(raw, keys, columns, keytype)
} else {
data.frame()
}
}
)
.createPROVEANDbQuery <- function(x, keys, columns, keytype)
{
if (missing(keys) && missing(columns)) {
sql <- "SELECT * FROM proveandata"
}
if (!missing(keys)) {
if(.missingKeys(x, keys, "PROVEAN"))
return(character())
if (!missing(columns)) {
if (.missingCols(x, columns, "PROVEAN"))
return(character())
columns <- union(keytype, columns)
fmtcols <- paste(columns, collapse=",")
fmtkeys <- .sqlIn(keys)
sql <- paste("SELECT ", fmtcols, " FROM proveandata WHERE ",
keytype, " IN (", fmtkeys, ")", sep="")
} else {
fmtkeys <- .sqlIn(keys)
sql <- paste("SELECT * FROM proveandata WHERE ", keytype,
" IN (", fmtkeys, ")", sep="")
}
} else {
if (.missingCols(x, columns, db="PROVEAN"))
return(character())
columns <- union(keytype, columns)
fmtcols <- paste(columns, collapse=",")
sql <- paste("SELECT ", fmtcols, " FROM proveandata", sep="")
}
sql
}
.formatPROVEANDbSelect <- function(raw, keys, columns, keytype)
{
## no data
if (!nrow(raw))
return(data.frame())
## remove duplicate rows
if (any(dup <- duplicated(raw)))
raw <- raw[!dup, ]
## reorder columns
if (!missing(columns)) {
if (!keytype %in% columns) columns <- c(keytype, columns)
raw <- raw[,colnames(raw) %in% columns]
}
## return keys not found
index <- unique(raw[[keytype]])
missing <- rep(FALSE, length(index))
if (!missing(keys)) {
missing <- (!keys %in% as.character(index))
lst <- as.list(rep(NA_character_, length(keys)))
for (i in which(missing == FALSE))
lst[[i]] <- raw[raw[[keytype]] %in% keys[i], ]
df <- do.call(rbind, lst)
df[[keytype]][is.na(df[[keytype]])] <- keys[missing]
rownames(df) <- NULL
df
} else {
rownames(raw) <- NULL
raw
}
}
|
