R/assign_slice.R
assign_slice.Rd
Uses if_else_block
.
assign_slice(source, testexpr, columns, value, env = parent.frame())
optree relop node or data.frame.
character containing the test expression.
character vector of column names to alter.
value to set in matching rows and columns (scalar).
environment to look to.
optree or data.frame.
Note: ifebtest_*
is a reserved column name for this procedure.
if (requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) {
my_db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
d <- rq_copy_to(
my_db,
'd',
data.frame(i = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
a = c(0, 0, 1, 1, 1, 1, 1, 1, 1, 1),
b = c(0, 1, 0, 1, 1, 1, 1, 1, 1, 1),
r = runif(10)),
temporary=TRUE, overwrite=TRUE)
optree <- d %.>%
assign_slice(.,
testexpr = qe(r<0.5),
columns = qc(a, b),
value = 2)
cat(format(optree))
sql <- to_sql(optree, my_db)
cat(sql)
print(DBI::dbGetQuery(my_db, sql))
DBI::dbDisconnect(my_db)
}
#> mk_td("d", c(
#> "i",
#> "a",
#> "b",
#> "r")) %.>%
#> extend(.,
#> ifebtest_1 := r < 0.5) %.>%
#> extend(.,
#> a := ifelse(ifebtest_1, 2, a),
#> b := ifelse(ifebtest_1, 2, b)) %.>%
#> drop_columns(.,
#> c('ifebtest_1'))
#> SELECT
#> `i`,
#> `a`,
#> `b`,
#> `r`
#> FROM (
#> SELECT
#> `i`,
#> `r`,
#> ( CASE WHEN ( `ifebtest_1` ) THEN ( 2 ) WHEN NOT ( `ifebtest_1` ) THEN ( `a` ) ELSE NULL END ) AS `a`,
#> ( CASE WHEN ( `ifebtest_1` ) THEN ( 2 ) WHEN NOT ( `ifebtest_1` ) THEN ( `b` ) ELSE NULL END ) AS `b`
#> FROM (
#> SELECT
#> `i`,
#> `a`,
#> `b`,
#> `r`,
#> `r` < 0.5 AS `ifebtest_1`
#> FROM (
#> SELECT
#> `i`,
#> `a`,
#> `b`,
#> `r`
#> FROM
#> `d`
#> ) tsql_49108401696977695962_0000000000
#> ) tsql_49108401696977695962_0000000001
#> ) tsql_49108401696977695962_0000000002
#> i a b r
#> 1 1 2 2 0.4441498
#> 2 2 2 2 0.2817941
#> 3 3 2 2 0.2347658
#> 4 4 1 1 0.8467117
#> 5 5 1 1 0.6910752
#> 6 6 2 2 0.4171049
#> 7 7 1 1 0.9734707
#> 8 8 1 1 0.8595053
#> 9 9 1 1 0.6510097
#> 10 10 1 1 0.8288511