File: test_select.R

package info (click to toggle)
r-bioc-annotationdbi 1.44.0-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 8,456 kB
  • sloc: sql: 10,876; sh: 4; makefile: 2
file content (75 lines) | stat: -rw-r--r-- 2,579 bytes parent folder | download | duplicates (3)
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
## One strategy is to put some of my examples (with expected output into here)
## - but this is fragile unless I also provide a localized example DB (which I
## probably should do anyways for other reasons, but is not necessarily useful
## here).
## Another strategy is that I should probably have tests for all my helper
## functions to make sure that they are returning what is expected.
## Generally, I want to make tests for each thing that can go wrong due to
## changes elsewhere.  The strategy of writing tests for the helpers will
## catch some of this, but also I need to anticipate things that will change
## in the annotations etc.

##  library(AnnotationDbi);AnnotationDbi:::.test()
require(RSQLite)
require(GO.db)
require("RUnit")

## resort and friends are really important as they are generic enough to
## be reused elsewhere.
test_generateExtraRows <- function(){
  ttab = data.frame(warpbreaks[1:10,])
  ttab$breaks <- as.character(ttab$breaks)  
  tkeys = ttab$breaks
  tkeys = c(26, tkeys[1:7], tkeys[7], 30, tkeys[8:10], tkeys[10])
  res <- AnnotationDbi:::.generateExtraRows(ttab, tkeys, jointype='breaks')
  expLen <- sum(table(tkeys) * table(ttab$breaks))
  checkTrue(expLen == dim(res)[1])
}

test_dropUnwantedRows <- function() {
    fun <- AnnotationDbi:::.dropUnwantedRows

    ## no duplicates, no changes
    keys <- letters[1:5]
    tab <- data.frame(x=keys, y=LETTERS[1:5], z=LETTERS[5:1],
                      row.names=NULL)
    checkIdentical(tab, fun(tab, keys, "x"))

    ## duplicate jointype element, duplicate dropped
    tab1 <- tab[c(1:5, 3L),]
    rownames(tab1) <- NULL
    checkIdentical(tab, fun(tab1, keys, "x"))

    ## unique all NA (other than jointype column) _retained_
    tab1 <- tab
    tab1[3, 2:3] <- NA
    rownames(tab1) <- NULL
    checkIdentical(tab1, fun(tab1, keys, "x"))

    ## duplicate all NA, made unique
    tab1 <- tab
    tab1[3, 2:3] <- NA
    tab2 <- tab1[c(1:5, 3),]
    checkIdentical(tab1,  fun(tab2, keys, "x"))

    ## duplicate key, dropped
    keys1 <- keys[c(1:5, 3)]
    checkIdentical(tab, fun(tab, keys1, "x"))
}


#########################################################################
## These ones are to test out some real use cases...

test_select5 <- function(){
  keys <- head(keys(GO.db), n=4)
  cols <- c("TERM","ONTOLOGY","DEFINITION")
  res <- select(GO.db, keys, cols)
  checkTrue(dim(res)[1]>0)
  checkTrue(dim(res)[2]==4)
  checkIdentical(c("GOID","TERM","ONTOLOGY","DEFINITION"), colnames(res))
}


## Fast checking:
## BiocGenerics:::testPackage(pattern="^test_select.*\\.R$")