tests/reg-tests.R

   1 library(filehash)
   2
   3 ######################################################################
   4 ## Test 'filehashRDS' class
   5
   6 dbCreate("mydbRDS", "RDS")
   7 db <- dbInit("mydbRDS", "RDS")
   8 show(db)
   9
  10 ## Put some data into it
  11 set.seed(1000)
  12 dbInsert(db, "a", 1:10)
  13 dbInsert(db, "b", rnorm(100))
  14 dbInsert(db, "c", 100:1)
  15 dbInsert(db, "d", runif(1000))
  16 dbInsert(db, "other", "hello")
  17
  18 dbList(db)
  19
  20 dbExists(db, "e")
  21 dbExists(db, "a")
  22
  23 env <- db2env(db)
  24 ls(env)
  25
  26 env$a
  27 env$b
  28 env$c
  29 str(env$d)
  30 env$other
  31
  32 env$b <- rnorm(100)
  33 mean(env$b)
  34
  35 env$a[1:5] <- 5:1
  36 print(env$a)
  37
  38 dbDelete(db, "c")
  39
  40 tryCatch(print(env$c), error = function(e) cat(as.character(e)))
  41 tryCatch(dbFetch(db, "c"), error = function(e) cat(as.character(e)))
  42
  43 ## Check trailing '/' problem
  44 dbCreate("testRDSdb", "RDS")
  45 db <- dbInit("testRDSdb/", "RDS")
  46 print(db)
  47
  48 ######################################################################
  49 ## test filehashDB1 class
  50
  51 dbCreate("mydb", "DB1")
  52 db <- dbInit("mydb", "DB1")
  53
  54 ## Put some data into it
  55 set.seed(1000)
  56 dbInsert(db, "a", 1:10)
  57 dbInsert(db, "b", rnorm(100))
  58 dbInsert(db, "c", 100:1)
  59 dbInsert(db, "d", runif(1000))
  60 dbInsert(db, "other", "hello")
  61
  62 dbList(db)
  63
  64 env <- db2env(db)
  65 ls(env)
  66
  67 env$a
  68 env$b
  69 env$c
  70 str(env$d)
  71 env$other
  72
  73 env$b <- rnorm(100)
  74 mean(env$b)
  75
  76 env$a[1:5] <- 5:1
  77 print(env$a)
  78
  79 dbDelete(db, "c")
  80
  81 tryCatch(print(env$c), error = function(e) cat(as.character(e)))
  82 tryCatch(dbFetch(db, "c"), error = function(e) cat(as.character(e)))
  83
  84 numbers <- rnorm(100)
  85 dbInsert(db, "numbers", numbers)
  86 b <- dbFetch(db, "numbers")
  87 stopifnot(all.equal(numbers, b))
  88 stopifnot(identical(numbers, b))
  89
  90 ################################################################################
  91 ## Other tests
  92
  93 rm(list = ls())
  94
  95
  96 dbCreate("testLoadingDB", "DB1")
  97 db <- dbInit("testLoadingDB", "DB1")
  98
  99 set.seed(234)
 100
 101 db$a <- rnorm(100)
 102 db$b <- runif(1000)
 103
 104 dbLoad(db)  ## 'a', 'b'
 105 summary(a)
 106 summary(b)
 107
 108 rm(list = ls())
 109 db <- dbInit("testLoadingDB", "DB1")
 110
 111 dbLazyLoad(db)
 112
 113 summary(a)
 114 summary(b)
 115
 116
 117
 118 ################################################################################
 119 ## Check dbReorganize
 120
 121 dbCreate("test_reorg", "DB1")
 122 db <- dbInit("test_reorg", "DB1")
 123
 124 set.seed(1000)
 125 dbInsert(db, "a", 1)
 126 dbInsert(db, "a", 1)
 127 dbInsert(db, "a", 1)
 128 dbInsert(db, "a", 1)
 129 dbInsert(db, "b", rnorm(1000))
 130 dbInsert(db, "b", rnorm(1000))
 131 dbInsert(db, "b", rnorm(1000))
 132 dbInsert(db, "b", rnorm(1000))
 133 dbInsert(db, "c", runif(1000))
 134 dbInsert(db, "c", runif(1000))
 135 dbInsert(db, "c", runif(1000))
 136 dbInsert(db, "c", runif(1000))
 137
 138 summary(db$b)
 139 summary(db$c)
 140
 141 print(file.info(db@datafile)$size)
 142
 143 dbReorganize(db)
 144
 145 db <- dbInit("test_reorg", "DB1")
 146
 147 print(file.info(db@datafile)$size)
 148
 149 summary(db$b)
 150 summary(db$c)
 151
 152
 153 ################################################################################
 154 ## Taken from the vignette
 155
 156 file.remove("mydb")
 157
 158 dbCreate("mydb")
 159 db <- dbInit("mydb")
 160
 161 set.seed(100)
 162
 163 dbInsert(db, "a", rnorm(100))
 164 value <- dbFetch(db, "a")
 165 mean(value)
 166
 167 dbInsert(db, "b", 123)
 168 dbDelete(db, "a")
 169 dbList(db)
 170 dbExists(db, "a")
 171
 172 file.remove("mydb")
 173
 174 ################################################################################
 175 ## Check queue
 176
 177 db <- createQ("testq")
 178 push(db, 1)
 179 push(db, 2)
 180 top(db)
 181
 182 pop(db)
 183 top(db)