## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----va-engine, echo = FALSE, results = "asis", eval = TRUE-------------------
cat("<script>\n", paste(readLines("va-engine.js"), collapse = "\n"), "\n</script>\n", sep = "")

## ----streaming-memory-anim, echo = FALSE, results = "asis", eval = TRUE-------
body <- "
var s=VA.setup('sm-cv'); if(!s)return; var x=s.ctx,W=s.w,H=s.h,C=VA.C;
var PX=72,PY=58,PW=W-72-36,PH=H-58-66,RAM=0.74;
var PERIOD=12.0;
function draw(tc){VA.bg(x,W,H);
  VA.title(x,'Memory as rows are processed');
  x.strokeStyle=C.mut;x.lineWidth=1;x.beginPath();x.moveTo(PX,PY);x.lineTo(PX,PY+PH);x.lineTo(PX+PW,PY+PH);x.stroke();
  x.fillStyle=C.mut;x.font=VA.F(11);x.textAlign='right';x.fillText('memory',PX-6,PY+10);x.textAlign='center';x.fillText('rows processed',PX+PW/2,PY+PH+24);
  var ry=PY+PH*(1-RAM);x.strokeStyle=C.red;x.setLineDash([6,4]);x.beginPath();x.moveTo(PX,ry);x.lineTo(PX+PW,ry);x.stroke();x.setLineDash([]);x.fillStyle=C.red;x.font=VA.F(11,true);x.textAlign='left';x.fillText('RAM limit',PX+6,ry-6);
  var t=VA.ease(VA.clamp(tc/(PERIOD-1.2),0,1)),le=Math.floor(t*PW);
  var redMax=1.16;
  x.strokeStyle=C.red;x.lineWidth=2.5;x.beginPath();
  for(var i=0;i<=le;i++){var v=(i/PW)*redMax;x.lineTo(PX+i,PY+PH*(1-Math.min(v,1.02)));}x.stroke();
  var g=0.16;x.strokeStyle=C.green;x.lineWidth=2.5;x.beginPath();
  for(var i=0;i<=le;i++){x.lineTo(PX+i,PY+PH*(1-g-0.012*Math.sin(i/13)));}x.stroke();
  var LX=PX+Math.min(le,PW-96),SY=PY+PH*(1-g)-9;
  x.fillStyle=C.green;x.font=VA.F(12,true);x.textAlign='left';x.fillText('streaming',LX,SY);
  var redv=t*redMax,ly=PY+PH*(1-Math.min(redv,1.02));x.fillStyle=C.red;x.fillText('in memory',LX,Math.min(Math.max(PY+13,ly-9),SY-20));
  x.fillStyle=C.mut;x.font=VA.F(11);x.textAlign='center';x.fillText('streaming keeps the footprint flat as the file grows',W/2,H-14);
}
VA.run(draw,PERIOD,null,'sm','sm-cv');
"
cat(paste0(
  "<canvas id='sm-cv' width='760' height='340' style='max-width:100%'></canvas>\n",
  "<script>\n(function(){\n", body, "\n})();\n</script>\n"))

## ----ram-box-anim, echo = FALSE, results = "asis", eval = TRUE----------------
body <- "
var s=VA.setup('rb-cv'); if(!s)return; var x=s.ctx,W=s.w,H=s.h,C=VA.C;
var BX=150,BW=W-150-40,RAM=0.7,ramX=BX+BW*RAM,BH=52,PERIOD=11.0;
var rows=[
 {y:88,name:'in memory',over:true,segs:[['data',0.44,'cyan'],['working copy',0.34,'amber'],['R',0.15,'purple']]},
 {y:176,name:'streaming',over:false,segs:[['batch',0.09,'green'],['R',0.15,'purple']]}
];
function draw(tc){VA.bg(x,W,H);
  VA.title(x,'What has to fit in RAM');
  x.strokeStyle=C.red;x.setLineDash([6,4]);x.beginPath();x.moveTo(ramX,58);x.lineTo(ramX,H-46);x.stroke();x.setLineDash([]);x.fillStyle=C.red;x.font=VA.F(12,true);x.textAlign='left';x.fillText('RAM',ramX+8,70);
  var t=VA.ease(VA.clamp(tc/(PERIOD-1.6),0,1));
  for(var r=0;r<2;r++){var rw=rows[r],X=BX;
    x.fillStyle=C.ink;x.font=VA.F(13,true);x.textAlign='right';x.fillText(rw.name,BX-14,rw.y+BH/2+5);
    for(var k=0;k<rw.segs.length;k++){var seg=rw.segs[k],w=seg[1]*BW*t;
      x.fillStyle=C[seg[2]];x.globalAlpha=0.85;x.fillRect(X,rw.y,w,BH);x.globalAlpha=1;x.strokeStyle=C.bg;x.lineWidth=1.5;x.strokeRect(X,rw.y,w,BH);
      x.font=VA.F(11,true);if(w>x.measureText(seg[0]).width+12){x.fillStyle=C.bg;x.textAlign='center';x.fillText(seg[0],X+w/2,rw.y+BH/2+4);}
      X+=w;}
    if(rw.over&&X>ramX){var ox=Math.max(ramX,BX);x.save();x.beginPath();x.rect(ox,rw.y,X-ox,BH);x.clip();x.strokeStyle=VA.A(C.red,0.5);x.lineWidth=1.5;for(var hx=ox-BH;hx<X;hx+=10){x.beginPath();x.moveTo(hx,rw.y+BH);x.lineTo(hx+BH,rw.y);x.stroke();}x.restore();x.strokeStyle=C.red;x.lineWidth=2;x.strokeRect(ox,rw.y,X-ox,BH);x.lineWidth=1;}
    if(!rw.over){x.fillStyle=C.green;x.font=VA.F(12,true);x.textAlign='left';x.fillText('fits',X+12,rw.y+BH/2+5);}}
  x.fillStyle=C.mut;x.font=VA.F(11);x.textAlign='center';x.fillText('streaming holds one batch and R at a time',W/2,H-14);
}
VA.run(draw,PERIOD,null,'rb','rb-cv');
"
cat(paste0(
  "<canvas id='rb-cv' width='760' height='300' style='max-width:100%'></canvas>\n",
  "<script>\n(function(){\n", body, "\n})();\n</script>\n"))

## ----lazy-pipeline-anim, echo = FALSE, results = "asis", eval = TRUE----------
body <- "
var s=VA.setup('lp-cv'); if(!s)return; var x=s.ctx,W=s.w,H=s.h,C=VA.C;
var nodes=[{n:'scan',d:'read row group',c:'cyan'},{n:'filter',d:'cyl > 4',c:'amber'},{n:'project',d:'mpg, hp',c:'green'},{n:'collect',d:'data.frame',c:'purple'}];
var NN=nodes.length,BW=300,BX=W/2-BW/2,BH=44,GAPY=22,TOP=70;
var BUILD=0.9,buildEnd=NN*BUILD+0.3,PULL=5.0,PERIOD=buildEnd+2*PULL;
function ny(i){return TOP+i*(BH+GAPY);}
function box(i,active){var y=ny(i),nd=nodes[i],col=C[nd.c];x.fillStyle=active?VA.A(col,0.12):C.bg;x.strokeStyle=active?col:VA.A(C.mut,0.45);x.lineWidth=active?2:1;x.beginPath();x.rect(BX,y,BW,BH);x.fill();x.stroke();x.lineWidth=1;x.fillStyle=active?C.ink:C.mut;x.font=VA.F(13,true);x.textAlign='left';x.fillText(nd.n+'()',BX+14,y+19);x.fillStyle=col;x.font=VA.F(11);x.fillText(nd.d,BX+14,y+35);}
function arrow(i){var y0=ny(i)+BH,y1=ny(i+1);x.strokeStyle=VA.A(C.mut,0.6);x.lineWidth=1;x.beginPath();x.moveTo(BX+BW/2,y0);x.lineTo(BX+BW/2,y1);x.stroke();}
function token(tx,ty,col,lab){x.fillStyle=col;x.beginPath();x.arc(tx,ty,6,0,6.2832);x.fill();x.font=VA.F(10,true);x.textAlign='center';x.fillText(lab,tx,ty-12);}
function draw(tc){VA.bg(x,W,H);
  VA.title(x,'A lazy plan, then one batch pulled through');
  var built=tc<buildEnd?Math.min(NN,Math.floor(tc/BUILD)+1):NN;
  for(var i=0;i<built-1;i++)arrow(i);
  var pulling=tc>=buildEnd,reqPos=-1,batchPos=-1;
  if(pulling){var pt=((tc-buildEnd)%PULL)/PULL;if(pt<0.4)reqPos=(NN-1)-(pt/0.4)*(NN-1);else batchPos=((pt-0.4)/0.6)*(NN-1);}
  for(var i=0;i<built;i++){var lit=pulling?((reqPos>=0&&Math.abs(i-reqPos)<0.55)||(batchPos>=0&&Math.abs(i-batchPos)<0.55)):true;box(i,lit);}
  if(reqPos>=0)token(BX-26,ny(0)+BH/2+reqPos*(BH+GAPY),C.cyan,'pull');
  if(batchPos>=0)token(BX+BW+26,ny(0)+BH/2+batchPos*(BH+GAPY),C.green,'batch');
  x.fillStyle=C.mut;x.font=VA.F(11);x.textAlign='center';x.fillText(pulling?'collect() requests; one batch flows back up the tree':'building the plan, no data moves yet',W/2,H-16);
}
VA.run(draw,PERIOD,null,'lp','lp-cv');
"
cat(paste0(
  "<canvas id='lp-cv' width='760' height='348' style='max-width:100%'></canvas>\n",
  "<script>\n(function(){\n", body, "\n})();\n</script>\n"))

## ----write-read---------------------------------------------------------------
library(vectra)

f <- tempfile(fileext = ".vtr")
write_vtr(mtcars, f)

node <- tbl(f)
node

## ----collect------------------------------------------------------------------
tbl(f) |> collect() |> head()

## ----write-batch-size---------------------------------------------------------
f_batched <- tempfile(fileext = ".vtr")
write_vtr(mtcars, f_batched, batch_size = 10)
tbl(f_batched) |> collect() |> nrow()

## ----filter-and---------------------------------------------------------------
tbl(f) |>
  filter(cyl == 6, mpg > 19) |>
  select(mpg, cyl, hp, wt) |>
  collect()

## ----filter-or----------------------------------------------------------------
tbl(f) |>
  filter(cyl == 4 | cyl == 8) |>
  select(mpg, cyl) |>
  collect() |>
  head()

## ----filter-in----------------------------------------------------------------
tbl(f) |>
  filter(cyl %in% c(4, 6)) |>
  select(mpg, cyl) |>
  collect() |>
  head()

## ----select-helpers-----------------------------------------------------------
tbl(f) |>
  select(starts_with("d"), mpg) |>
  collect() |>
  head()

## ----select-negate------------------------------------------------------------
tbl(f) |>
  select(-am, -vs, -gear, -carb) |>
  collect() |>
  head()

## ----explain-filter-----------------------------------------------------------
tbl(f) |>
  filter(cyl > 4) |>
  select(mpg, cyl, hp) |>
  explain()

## ----mutate-arith-------------------------------------------------------------
tbl(f) |>
  mutate(kpl = mpg * 0.425144, hp_per_wt = hp / wt) |>
  select(mpg, kpl, hp, wt, hp_per_wt) |>
  collect() |>
  head()

## ----mutate-math--------------------------------------------------------------
tbl(f) |>
  mutate(
    log_hp = log(hp),
    hp_floor = floor(hp / 10) * 10,
    bounded = pmin(pmax(mpg, 15), 25)
  ) |>
  select(hp, log_hp, hp_floor, mpg, bounded) |>
  collect() |>
  head()

## ----transmute----------------------------------------------------------------
tbl(f) |>
  transmute(
    efficiency = mpg / wt,
    power_ratio = hp / disp
  ) |>
  collect() |>
  head()

## ----mutate-cast--------------------------------------------------------------
tbl(f) |>
  mutate(cyl_str = as.character(cyl)) |>
  select(cyl, cyl_str) |>
  collect() |>
  head(3)

## ----mutate-control-----------------------------------------------------------
tbl(f) |>
  mutate(
    size = case_when(
      cyl == 4 ~ "small",
      cyl == 6 ~ "medium",
      cyl == 8 ~ "large"
    ),
    mpg_class = if_else(mpg > 20, "high", "low"),
    in_range = between(hp, 100, 200)
  ) |>
  select(cyl, size, mpg, mpg_class, hp, in_range) |>
  collect() |>
  head()

## ----mutate-coalesce----------------------------------------------------------
df_na <- data.frame(
  a = c(NA, 2, NA, 4),
  b = c(10, NA, NA, 40),
  stringsAsFactors = FALSE
)
f_na <- tempfile(fileext = ".vtr")
write_vtr(df_na, f_na)

tbl(f_na) |>
  mutate(filled = coalesce(a, b, 0)) |>
  collect()

## ----string-data--------------------------------------------------------------
people <- data.frame(
  name = c("  Alice  ", "Bob", "Charlie Brown", "Diana"),
  city = c("Amsterdam", "Berlin", "Chicago", "Dublin"),
  email = c("alice@example.com", "bob@test.org",
            "charlie.b@work.net", "diana@example.com"),
  stringsAsFactors = FALSE
)
fs <- tempfile(fileext = ".vtr")
write_vtr(people, fs)

## ----string-basic-------------------------------------------------------------
tbl(fs) |>
  mutate(
    name_trimmed = trimws(name),
    name_len = nchar(trimws(name)),
    city_prefix = substr(city, 1, 3)
  ) |>
  select(name_trimmed, name_len, city_prefix) |>
  collect()

## ----string-case--------------------------------------------------------------
tbl(fs) |>
  mutate(
    city_upper = toupper(city),
    is_example = endsWith(email, "example.com"),
    starts_a = startsWith(city, "A")
  ) |>
  select(city_upper, email, is_example, starts_a) |>
  collect()

## ----string-grepl-------------------------------------------------------------
tbl(fs) |>
  mutate(has_at = grepl("@example", email)) |>
  select(email, has_at) |>
  collect()

## ----string-gsub--------------------------------------------------------------
tbl(fs) |>
  mutate(domain = gsub(".*@", "", email, fixed = FALSE)) |>
  select(email, domain) |>
  collect()

## ----string-extract-----------------------------------------------------------
tbl(fs) |>
  mutate(user = str_extract(email, "^[^@]+")) |>
  select(email, user) |>
  collect()

## ----string-paste-------------------------------------------------------------
tbl(fs) |>
  mutate(
    greeting = paste0("Hello, ", trimws(name), "!"),
    label = paste(trimws(name), city, sep = " - ")
  ) |>
  select(greeting, label) |>
  collect()

## ----summarise-basic----------------------------------------------------------
tbl(f) |>
  group_by(cyl) |>
  summarise(
    count = n(),
    avg_mpg = mean(mpg),
    total_hp = sum(hp),
    best_mpg = max(mpg)
  ) |>
  collect()

## ----summarise-advanced-------------------------------------------------------
tbl(f) |>
  group_by(cyl) |>
  summarise(
    mpg_sd = sd(mpg),
    mpg_var = var(mpg),
    first_hp = first(hp),
    last_hp = last(hp)
  ) |>
  collect()

## ----summarise-median---------------------------------------------------------
tbl(f) |>
  group_by(cyl) |>
  summarise(
    med_mpg = median(mpg),
    unique_gears = n_distinct(gear)
  ) |>
  collect()

## ----count--------------------------------------------------------------------
tbl(f) |>
  count(cyl, sort = TRUE) |>
  collect()

## ----tally--------------------------------------------------------------------
tbl(f) |>
  group_by(gear) |>
  tally() |>
  collect()

## ----across-summarise---------------------------------------------------------
tbl(f) |>
  group_by(cyl) |>
  summarise(across(c(mpg, hp, wt), mean)) |>
  collect()

## ----across-multi-------------------------------------------------------------
tbl(f) |>
  group_by(cyl) |>
  summarise(across(
    c(mpg, hp),
    list(avg = mean, total = sum),
    .names = "{.col}_{.fn}"
  )) |>
  collect()

## ----ungroup------------------------------------------------------------------
tbl(f) |>
  group_by(cyl, gear) |>
  summarise(n = n(), .groups = "keep") |>
  ungroup() |>
  arrange(desc(n)) |>
  collect()

## ----arrange------------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl, hp) |>
  arrange(cyl, desc(mpg)) |>
  collect() |>
  head(8)

## ----slice-head---------------------------------------------------------------
tbl(f) |>
  slice_head(n = 5) |>
  collect()

## ----slice-min----------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl, hp) |>
  slice_min(order_by = mpg, n = 3) |>
  collect()

## ----slice-no-ties------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl) |>
  slice_min(order_by = cyl, n = 3, with_ties = FALSE) |>
  collect()

## ----slice-max----------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl, hp) |>
  slice_max(order_by = hp, n = 4, with_ties = FALSE) |>
  collect()

## ----join-setup---------------------------------------------------------------
cyl_info <- data.frame(
  cyl = c(4, 6, 8),
  engine_type = c("inline", "v-type", "v-type"),
  stringsAsFactors = FALSE
)
f_cyl <- tempfile(fileext = ".vtr")
write_vtr(cyl_info, f_cyl)

## ----left-join----------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl, hp) |>
  left_join(tbl(f_cyl), by = "cyl") |>
  collect() |>
  head()

## ----semi-anti----------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl) |>
  anti_join(
    tbl(f_cyl) |> filter(engine_type == "v-type"),
    by = "cyl"
  ) |>
  collect() |>
  head()

## ----join-named---------------------------------------------------------------
ratings <- data.frame(
  cylinders = c(4, 6, 8),
  rating = c("A", "B", "C"),
  stringsAsFactors = FALSE
)
f_rat <- tempfile(fileext = ".vtr")
write_vtr(ratings, f_rat)

tbl(f) |>
  select(mpg, cyl) |>
  inner_join(tbl(f_rat), by = c("cyl" = "cylinders")) |>
  collect() |>
  head()

## ----fuzzy-join---------------------------------------------------------------
ref_species <- data.frame(
  canonical = c("Quercus robur", "Quercus petraea",
                 "Fagus sylvatica"),
  code = c("QR", "QP", "FS"),
  stringsAsFactors = FALSE
)
query_species <- data.frame(
  name = c("Quercus robur", "Qurecus petraea",
           "Fagus sylvatca"),
  stringsAsFactors = FALSE
)
f_ref <- tempfile(fileext = ".vtr")
f_query <- tempfile(fileext = ".vtr")
write_vtr(ref_species, f_ref)
write_vtr(query_species, f_query)

tbl(f_query) |>
  fuzzy_join(
    tbl(f_ref),
    by = c("name" = "canonical"),
    method = "dl",
    max_dist = 0.15
  ) |>
  collect()

## ----window-rank--------------------------------------------------------------
tbl(f) |>
  select(mpg, cyl, hp) |>
  slice_head(n = 8) |>
  mutate(
    rn = row_number(),
    mpg_rank = rank(mpg),
    mpg_dense = dense_rank(mpg)
  ) |>
  collect()

## ----window-lag-lead----------------------------------------------------------
tbl(f) |>
  select(mpg, hp) |>
  slice_head(n = 6) |>
  mutate(
    prev_mpg = lag(mpg),
    next_mpg = lead(mpg),
    prev2_hp = lag(hp, n = 2, default = 0)
  ) |>
  collect()

## ----window-cum---------------------------------------------------------------
tbl(f) |>
  select(mpg, hp) |>
  slice_head(n = 6) |>
  mutate(
    running_hp = cumsum(hp),
    running_avg = cummean(mpg),
    running_min = cummin(mpg)
  ) |>
  collect()

## ----window-grouped-----------------------------------------------------------
tbl(f) |>
  select(mpg, cyl) |>
  group_by(cyl) |>
  mutate(rn = row_number(), pct = percent_rank(mpg)) |>
  slice_head(n = 10) |>
  collect()

## ----date-data----------------------------------------------------------------
events <- data.frame(
  event_date = as.Date(c("2020-03-15", "2020-07-01",
                          "2021-01-15", "2021-06-30")),
  event_time = as.POSIXct(c("2020-03-15 09:30:00",
                             "2020-07-01 14:00:00",
                             "2021-01-15 08:15:00",
                             "2021-06-30 17:45:00"),
                           tz = "UTC"),
  value = c(10, 20, 30, 40)
)
fd <- tempfile(fileext = ".vtr")
write_vtr(events, fd)

## ----date-extract-------------------------------------------------------------
tbl(fd) |>
  mutate(
    yr = year(event_date),
    mo = month(event_date),
    dy = day(event_date)
  ) |>
  group_by(yr) |>
  summarise(total = sum(value)) |>
  collect()

## ----time-extract-------------------------------------------------------------
tbl(fd) |>
  mutate(
    hr = hour(event_time),
    mn = minute(event_time)
  ) |>
  select(event_time, hr, mn) |>
  collect()

## ----date-filter--------------------------------------------------------------
tbl(fd) |>
  filter(event_date >= as.Date("2021-01-01")) |>
  collect()

## ----date-arith---------------------------------------------------------------
tbl(fd) |>
  mutate(plus_30 = event_date + 30) |>
  select(event_date, plus_30) |>
  collect()

## ----similarity-data----------------------------------------------------------
species <- data.frame(
  name = c("Quercus robur", "Quercus rubra",
           "Fagus sylvatica", "Acer platanoides",
           "Quercus petraea"),
  stringsAsFactors = FALSE
)
fs2 <- tempfile(fileext = ".vtr")
write_vtr(species, fs2)

## ----similarity-metrics-------------------------------------------------------
tbl(fs2) |>
  mutate(
    lev = levenshtein(name, "Quercus robur"),
    dl = dl_dist(name, "Quercus robur"),
    jw = jaro_winkler(name, "Quercus robur")
  ) |>
  filter(lev <= 5) |>
  arrange(lev) |>
  collect()

## ----similarity-norm----------------------------------------------------------
tbl(fs2) |>
  mutate(
    lev_norm = levenshtein_norm(name, "Quercus robur"),
    dl_norm = dl_dist_norm(name, "Quercus robur")
  ) |>
  collect()

## ----dl-transposition---------------------------------------------------------
tbl(fs2) |>
  mutate(
    lev = levenshtein(name, "Qurecus robur"),
    dl = dl_dist(name, "Qurecus robur")
  ) |>
  collect()

## ----resolve------------------------------------------------------------------
taxa <- data.frame(
  id        = c(1L, 2L, 3L, 4L),
  name      = c("Fagaceae", "Quercus", "Q. robur", "Q. petraea"),
  parent_id = c(NA, 1L, 2L, 2L),
  stringsAsFactors = FALSE
)
ft <- tempfile(fileext = ".vtr")
write_vtr(taxa, ft)

tbl(ft) |>
  mutate(parent_name = resolve(parent_id, id, name)) |>
  collect()

## ----propagate----------------------------------------------------------------
tbl(ft) |>
  mutate(family = propagate(
    parent_id, id,
    if_else(is.na(parent_id), name, NA_character_)
  )) |>
  collect()

## ----csv-roundtrip------------------------------------------------------------
csv_in <- tempfile(fileext = ".csv")
write.csv(mtcars, csv_in, row.names = FALSE)

tbl_csv(csv_in) |>
  filter(cyl == 6) |>
  select(mpg, cyl, hp) |>
  collect()

## ----sqlite-roundtrip---------------------------------------------------------
db <- tempfile(fileext = ".sqlite")
f_src <- tempfile(fileext = ".vtr")
write_vtr(mtcars, f_src)
tbl(f_src) |> write_sqlite(db, "cars")

tbl_sqlite(db, "cars") |>
  filter(mpg > 25) |>
  collect()

## ----format-conversion--------------------------------------------------------
csv_file <- tempfile(fileext = ".csv")
vtr_file <- tempfile(fileext = ".vtr")
csv_out <- tempfile(fileext = ".csv")

write.csv(mtcars, csv_file, row.names = FALSE)
tbl_csv(csv_file) |> write_vtr(vtr_file)

tbl(vtr_file) |>
  filter(cyl == 6) |>
  write_csv(csv_out)

read.csv(csv_out) |> head()

## ----index-create-------------------------------------------------------------
f_idx <- tempfile(fileext = ".vtr")
write_vtr(
  data.frame(id = letters, val = 1:26, stringsAsFactors = FALSE),
  f_idx,
  batch_size = 5
)

has_index(f_idx, "id")  # FALSE
create_index(f_idx, "id")
has_index(f_idx, "id")  # TRUE

## ----index-query--------------------------------------------------------------
tbl(f_idx) |>
  filter(id == "m") |>
  collect()

## ----index-composite----------------------------------------------------------
f_comp <- tempfile(fileext = ".vtr")
write_vtr(
  data.frame(
    region = rep(c("north", "south"), each = 13),
    id = letters,
    val = 1:26,
    stringsAsFactors = FALSE
  ),
  f_comp,
  batch_size = 5
)
create_index(f_comp, c("region", "id"))

tbl(f_comp) |>
  filter(region == "north", id == "c") |>
  collect()

## ----append-------------------------------------------------------------------
fa <- tempfile(fileext = ".vtr")
write_vtr(mtcars[1:16, ], fa)
append_vtr(mtcars[17:32, ], fa)
tbl(fa) |> collect() |> nrow()

## ----delete-------------------------------------------------------------------
delete_vtr(fa, c(0, 1, 2))  # 0-based row indices
tbl(fa) |> collect() |> nrow()
unlink(c(fa, paste0(fa, ".del")))

## ----diff---------------------------------------------------------------------
fd1 <- tempfile(fileext = ".vtr")
fd2 <- tempfile(fileext = ".vtr")
old <- data.frame(id = 1:5, val = letters[1:5],
                  stringsAsFactors = FALSE)
new <- data.frame(id = c(3L, 4L, 5L, 6L, 7L),
                  val = c("C", "d", "e", "f", "g"),
                  stringsAsFactors = FALSE)
write_vtr(old, fd1)
write_vtr(new, fd2)

d <- diff_vtr(fd1, fd2, "id")
d$deleted
collect(d$added)
unlink(c(fd1, fd2))

## ----block-materialize--------------------------------------------------------
blk_data <- data.frame(
  taxonID = c("T1", "T2", "T3", "T4", "T5"),
  name = c("Quercus robur", "Pinus sylvestris",
           "Fagus sylvatica", "Acer campestre",
           "Betula pendula"),
  stringsAsFactors = FALSE
)
f_blk <- tempfile(fileext = ".vtr")
write_vtr(blk_data, f_blk)

blk <- materialize(tbl(f_blk))
blk

## ----block-lookup-------------------------------------------------------------
block_lookup(blk, "name", c("Quercus robur", "Betula pendula"))

## ----block-fuzzy--------------------------------------------------------------
block_fuzzy_lookup(
  blk, "name",
  c("Qurecus robur", "Pinus silvestris"),
  method = "dl",
  max_dist = 0.2
)

## ----explain-full-------------------------------------------------------------
tbl(f) |>
  filter(cyl > 4) |>
  select(mpg, cyl, hp) |>
  arrange(desc(mpg)) |>
  explain()

## ----glimpse------------------------------------------------------------------
tbl(f) |> glimpse()

## ----cleanup------------------------------------------------------------------
unlink(c(f, f_batched, f_na, fs, fs2, f_cyl, f_rat, f_ref, f_query, fd,
         ft, csv_in, csv_out, csv_file, vtr_file, db, f_src, f_idx,
         paste0(f_idx, ".id.vtri"), f_comp,
         paste0(f_comp, ".region_id.vtri"), f_blk))