library(datasets) # test if SQLiteDF successfully loaded. it should create (if it does not exist) # or open workspace.db in the current directory (assuming workspace.db is # a valid workspace file) library(SQLiteDF) stopifnot(file.exists(".SQLiteDF/workspace.db")) # test all modes iris <- cbind(iris, integers=1:10, logicals=c(T,F), chars=c("foo","bar")) # test creating unnamed sdfs u1.sdf <- sqlite.data.frame(iris) stopifnot(file.exists(".SQLiteDF/data1.db")) u2.sdf <- sqlite.data.frame(attenu) stopifnot(file.exists(".SQLiteDF/data2.db")) # test classes stopifnot(class(u1.sdf) == "sqlite.data.frame", class(u2.sdf) == "sqlite.data.frame") compareSdfToDf <- function(sdf, df, with.names=TRUE) { ncols <- ncol(df) nrows <- nrow(df) # test [.sqlite.data.frame for (i in 1:nrows) { for (j in 1:ncols) { if (df[i,j] != sdf[i,j]) stop("Not equal on ", i, ",", j, "\n") }} # test [[.sqlite.data.frame (int arg), [.sqlite.vector, # length.sqlite.vector, has.typeSvec for (j in 1:ncols) { sv <- sdf[[j]]; # test sqlite.vector stopifnot(class(sv) == "sqlite.vector", has.typeSvec(sv, class(df[[j]])[1])) if (length(sv) != nrows) stop("Unexpected # of rows for col", j, "\n") for (i in 1:nrows) if (sv[i] != df[i,j]) stop("Not equal on row ", i, ", col ", j, "\n") all.equal(sv[c(T,F,F)], df[c(T,F,F),j]) } # test names.sqlite.data.frame, [[.sqlite.data.frame (name arg), ... if (with.names) for (j in names(df)) { sv <- sdf[[j]]; # test sqlite.vector stopifnot(class(sv) == "sqlite.vector", has.typeSvec(sv, class(df[[j]])[1])) if (length(sv) != nrows) stop("Unexpected # of rows for col", j, "\n") for (i in 1:nrows) if (sv[i] != df[i,j]) stop("Not equal on", i, "on col", j, "\n") } # quote the 1st element of a vector suitable as arg to sdfSelect(where=) makewhere <- function(vect, name) { paste("[", name, "]=", switch(class(vect), numeric=as.character(vect[1]), factor=as.character(as.integer(vect[1])), ordered=as.character(as.integer(vect[1])), character=paste("'", vect[1], "'", sep=""), integer=as.character(vect[1]), logical=as.character(as.integer(vect[1]))), sep="") } # test sdfSelect returning vectors for (i in 1:ncols) { colname = paste("[",names(df)[i],"]", sep="") vect <- df[[i]] # test where arg with the 1st value of the vector testwhere = makewhere(vect, names(df)[i]) print(testwhere) stopifnot(all.equal(sdfSelect(sdf, select=colname), vect), all.equal(sdfSelect(sdf, select=colname, limit=nrows-1), vect[1:(nrows-1)]), all.equal(sdfSelect(sdf, select=colname, where=testwhere, debug=T), vect[vect == vect[1]])) } # test sdfSelect returning data frames select = paste(paste("[", names(df), "]", sep=""), collapse=",") where = makewhere(df[[1]], names(df)[1]) # row.names() not equal, & besides sdf returns char & # R has integer row.names stopifnot(all.equal(sdfSelect(sdf, select, limit="9,5"), df[10:14,], check.attributes=FALSE), all.equal(sdfSelect(sdf, limit=nrows-1), df[-nrows,], check.attributes=FALSE), all.equal(sdfSelect(sdf, where=where), df[df[[1]]==df[1,1],], check.attributes=FALSE)) } # test creating named sdfs iris.sdf <- sqlite.data.frame(iris, "iris") stopifnot(file.exists(".SQLiteDF/iris.db")) iris2.sdf <- sqlite.data.frame(iris, "iris") stopifnot(file.exists(".SQLiteDF/iris1.db")) # test lsSdf(), w/c queries workspace.db lsSdf() stopifnot((sort(lsSdf()) == c("data1", "data2", "iris", "iris1"))) # test attach/detach sdf detachSdf("data1") stopifnot(sort(lsSdf()) == c("data2", "iris", "iris1")) attachSdf(".SQLiteDF/data1.db") stopifnot(sort(lsSdf()) == sort(c("data2", "iris", "iris1", "data1"))) # test row.names, head, tail, "==.character" stopifnot(all(row.names(u1.sdf)==row.names(iris)), all(row.names(u2.sdf)==row.names(attenu)), all(head(u1.sdf) == head(iris)), all(head(u2.sdf) == head(attenu)), all(tail(u1.sdf) == tail(iris)), all(tail(u2.sdf) == tail(attenu))) # test sdf methods stopifnot(length(iris.sdf) == length(iris), length(row.names(iris.sdf)) == length(row.names(iris)), all(dim(iris.sdf) == dim(iris)), all(names(iris.sdf) == names(iris))) # test sdf indexers compareSdfToDf(iris.sdf, iris) #compareSdfToDf(u2.sdf, attenu) # problem with factors stopifnot(all.equal(unlist(iris.sdf),unlist(iris.sdf[])), all.equal(unlist(iris.sdf),unlist(iris.sdf[,]))) tmp <- iris.sdf[1] # sdf w/ ncol=1 stopifnot(nrow(tmp) == nrow(iris.sdf), names(tmp) == names(iris.sdf)[1], all.equal(tmp[,1], iris.sdf[,1])) # test operators stopifnot(all.equal(iris.sdf[,1] + iris.sdf[,2], iris[,1] + iris[,2]), all.equal(iris.sdf[,1]*10 %/% iris.sdf[,2],iris[,1]*10 %/% iris[,2]), all.equal(signif(log(iris.sdf[,1],17)), signif(log(iris[,1],17))), all.equal(round(log(iris.sdf[,1]),5), round(log(iris[,1]),5)), all.equal(with(iris.sdf, Sepal.Length*Sepal.Width - Petal.Length/Petal.Width), with(iris, Sepal.Length*Sepal.Width - Petal.Length/Petal.Width)), all.equal(sort(iris.sdf[,2]), sort(iris[,2])), all.equal(quantile(iris.sdf[,3]), quantile(iris[,3])), all.equal(sapply(iris.sdf[,1:4],mean), sapply(iris[,1:4],mean))) stopifnot(sapply(iris.sdf[,1:4],sum) == sapply(iris[,1:4],sum)) # test [<-.sqlite.vector ref <- data.frame( integer=1:10, real=as.real(1:10), logical=rep(c(T,F,T),length.out=10), character=I(c("one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten"))) ref.sdf <- sqlite.data.frame(ref) .assign <- function (svec, idx, values, eqvalues=values) { idxlen <- if (is.logical(idx)) sum(rep(idx, length.out=length(svec))) else length(idx) if (is.logical(idx)) idx <- rep(idx, length.out=length(svec)) if (length(values) != idxlen) values <- rep(values, length.out=idxlen) if (length(eqvalues) != idxlen) eqvalues <- rep(eqvalues, length.out=idxlen) svec[idx] <- values all.equal(svec[idx], eqvalues) } ## test real <- real, int, logical col = ref.sdf[["real"]] stopifnot(.assign(col, 1, 25), .assign(col, c(1,3,5,7,9), 100), .assign(col, c(1,3,5,7,9), c(25, 100)), .assign(col, c(2,4,6,8,10), c(T,F,T), as.real(c(T,F,T))), # w/ logicals .assign(col, c(4,5,6,7,8), 1:5, as.real(1:5)), # w/ ints .assign(col, c(T,F), 1:5, as.real(1:5))) # test int <- int, logical col = ref.sdf[["integer"]] stopifnot(.assign(col, 1, as.integer(25)), .assign(col, c(1,3,5,7,9), as.integer(100)), .assign(col, c(1,3,5,7,9), as.integer(c(25, 100))), .assign(col, c(2,4,6,8,10), c(T,F,T), as.integer(c(1,0,1))), # w/ logicals .assign(col, c(4,5,6,7,8), 1:5), # w/ ints .assign(col, c(T,F), 1:5)) # test logical <- logical col = ref.sdf[["logical"]] stopifnot(.assign(col, 1, F), .assign(col, c(1,3,5,7,9), F), .assign(col, c(F,T), T)) # test character <- character, real, int, logical col = ref.sdf[["character"]] stopifnot(.assign(col, 1, "isa"), .assign(col, c(1,3,5,7,9), c("uno", "tatlo", "lima", "pito", "syam")), .assign(col, 1, 25, "25"), .assign(col, 1, 3/4, "0.75"), # w/ reals .assign(col, 1:5, as.integer(3), "3"), # w/ integers .assign(col, 4:8, c(T,F), c("TRUE","FALSE"))) # w/ logicals # test sdfImportDBI #if (require(RSQLite)) { # dr <- SQLite() # con <- dbConnect(dr, dbname="example.db") # i1 <- sdfImportDBI(con, "select * from iris") # compareSdfToDf(i1[,1:4], iris[,1:4], with.names=FALSE) # stopifnot(all(as.character(i1[,5]) == as.character(iris[,5]))) # # i2 <- sdfImportDBI(con, "select * from iris", 30) # test rbindSdf # compareSdfToDf(i2[,1:4], iris[,1:4], with.names=FALSE) # stopifnot(all(as.character(i2[,5]) == as.character(iris[,5]))) #} # test rbindSdf rbindSdf(u2.sdf, attenu) stopifnot(2*nrow(attenu)==nrow(u2.sdf)) #print((nrow(attenu)+1):(nrow(u2.sdf))) #compareSdfToDf(u2.sdf[(nrow(attenu)+1):(nrow(u2.sdf)),], attenu) # test sdfImportSQLite k <- sdfImportSQLite("example.db", "iris") k1 <- k[,2:6] for (i in 1:4) stopifnot(all.equal(k1[,i],iris[,i])) stopifnot(all.equal(levels(k1[,5]),levels(iris[,5])), all.equal(as.integer(k1[,5]), as.integer(iris[,5]))) # test summary for (j in 1:5) stopifnot(all(summary(iris.sdf[,j]) == summary(iris[,j]))) iris.sdf.summary <- summary(iris.sdf) iris.summary <- summary(iris) stopifnot(all(iris.sdf.summary[,1:4] == iris.summary[,1:4])) stopifnot(all(na.exclude(iris.sdf.summary[,5])==na.exclude(iris.summary[,5]))) # test matrices on sdf's iris.mat <- as.matrix(iris) iris.smat <- sqlite.matrix(iris) stopifnot(typeSvec(iris.smat) == mode(iris.mat), length(iris.smat) == length(iris.mat), all(colnames(iris.smat) == colnames(iris.mat))) #all(rownames(iris.smat) == rownames(iris.mat))) # still bug here