Nothing
test_composite_control_keys_db <- function() {
# https://github.com/WinVector/cdata/issues/4
if((!requireNamespace("DBI", quietly = TRUE)) ||
(!requireNamespace("RSQLite", quietly = TRUE))) {
return(invisible(NULL))
}
raw_connection <- DBI::dbConnect(RSQLite::SQLite(),
":memory:")
RSQLite::initExtension(raw_connection)
dbopts <- rquery::rq_connection_tests(raw_connection)
db <- rquery::rquery_db_info(connection = raw_connection,
is_dbi = TRUE,
connection_options = dbopts)
d <- wrapr::build_frame(
"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species", "id" |
5.1 , 3.5 , 1.4 , 0.2 , "setosa" , 1L |
4.9 , 3 , 1.4 , 0.2 , "setosa" , 2L )
d_db <- rquery::rq_copy_to(db, "d", d,
temporary = TRUE,
overwrite = TRUE)
control_table <- wrapr::qchar_frame(
Part, Measure, Value |
Sepal, Length, Sepal.Length |
Sepal, Width, Sepal.Width |
Petal, Length, Petal.Length |
Petal, Width, Petal.Width )
res_db <- rowrecs_to_blocks(d_db,
control_table,
controlTableKeys = c("Part", "Measure"),
columnsToCopy = c("id", "Species"))
res_t <- rquery::materialize(db, res_db)
res_sql <- rquery::to_sql(res_db, db)
res <- rquery::execute(db, res_t)
expect <- wrapr::build_frame(
"id", "Species", "Part" , "Measure", "Value" |
1L , "setosa" , "Sepal", "Length" , 5.1 |
1L , "setosa" , "Sepal", "Width" , 3.5 |
1L , "setosa" , "Petal", "Length" , 1.4 |
1L , "setosa" , "Petal", "Width" , 0.2 |
2L , "setosa" , "Sepal", "Length" , 4.9 |
2L , "setosa" , "Sepal", "Width" , 3 |
2L , "setosa" , "Petal", "Length" , 1.4 |
2L , "setosa" , "Petal", "Width" , 0.2 )
expect_equal(sort(colnames(expect)), sort(colnames(res)))
res <- res[, colnames(expect), drop = FALSE]
expect <- expect[wrapr::orderv(expect[, c("id", "Species", "Part", "Measure")]), , drop = FALSE]
res <- res[wrapr::orderv(res[, c("id", "Species", "Part", "Measure")]), , drop = FALSE]
expect_equal(expect, res)
back_db <- blocks_to_rowrecs(res_db,
keyColumns = c("id", "Species"),
control_table,
controlTableKeys = c("Part", "Measure"))
back_t <- rquery::materialize(db, back_db)
back_sql <- rquery::to_sql(back_db, db)
back <- rquery::execute(db, back_t)
expect_equal(sort(colnames(d)), sort(colnames(back)))
back <- back[, colnames(d), drop = FALSE]
d <- d[wrapr::orderv(d), , drop = FALSE]
back <- back[wrapr::orderv(back), , drop = FALSE]
expect_equal(d, back)
DBI::dbDisconnect(raw_connection)
}
test_composite_control_keys_db()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.