Skip to content

Commit 0df9a1e

Browse files
author
Fred Wu
committed
server-side cached data viewer
1 parent 9803ae4 commit 0df9a1e

File tree

3 files changed

+218
-141
lines changed

3 files changed

+218
-141
lines changed

‎R/session/vsc.R‎

Lines changed: 184 additions & 112 deletions
Original file line numberDiff line numberDiff line change
@@ -101,131 +101,183 @@ get_column_def <- function(name, field, value) {
101101
)
102102
}
103103

104-
dataview_table <- function(data, start = 0, end = NULL, sortModel = NULL, filterModel = NULL) {
105-
106-
if (is.matrix(data)) {
107-
data <- as.data.frame.matrix(data)
108-
}
109-
if (!is.data.frame(data)) {
110-
stop("data must be a data.frame or a matrix")
111-
}
112-
113-
data <- data.table::copy(data)
114-
data.table::setDT(data)
115-
116-
data[, `:=`("(row)" = numeric(), rowId = .I)]
117-
data.table::setcolorder(data, neworder = c("(row)", "rowId"), before = 1)
118-
119-
# number of rows & original column names
120-
.nrow <- nrow(data)
121-
.colnames <- colnames(data)
122-
if (is.null(.colnames)) {
123-
.colnames <- sprintf("V%d", seq_len(ncol(data)))
124-
} else {
125-
.colnames <- trimws(.colnames)
126-
}
127-
128-
fields <- sprintf("x%d", seq_along(.colnames))
129-
field_map <- setNames(.colnames, fields)
130-
131-
if (!is.null(filterModel) && length(filterModel) > 0) {
104+
dataview_table <- local({
105+
cache_raw_dt <- NULL
106+
cache_filtered_dt <- NULL
107+
cache_dt <- NULL
108+
cache_nrow <- NULL
109+
cache_colnames <- NULL
110+
cache_fields <- NULL
111+
last_fm <- NULL
112+
last_sm <- NULL
113+
114+
function(data, start = 0, end = NULL,
115+
sortModel = NULL, filterModel = NULL,
116+
metadata_only = FALSE, force = FALSE) {
117+
118+
key <- attr(data, "_dvkey", exact = TRUE)
119+
if (is.null(key)) key <- "<default>"
120+
121+
if (is.matrix(data)) {
122+
data <- as.data.frame.matrix(data)
123+
}
124+
if (!is.data.frame(data)) {
125+
stop("data must be a data.frame/data.table or a matrix")
126+
}
132127

133-
filter_strings <- lapply(names(filterModel), function(fld) {
134-
fd <- filterModel[[fld]]
135-
col_name <- field_map[[fld]]
128+
# Metadata capture
129+
.nrow <- nrow(data)
130+
.colnames <- colnames(data)
131+
if (is.null(.colnames)) {
132+
.colnames <- sprintf("V%d", seq_len(ncol(data)))
133+
} else {
134+
.colnames <- trimws(.colnames)
135+
}
136+
fields <- sprintf("x%d", seq_len(length(.colnames) + 2))
137+
full_cols <- c("(row)", "rowId", .colnames)
138+
field_map <- setNames(full_cols, fields)
139+
140+
if (metadata_only) {
141+
meta_data <- data.table::as.data.table(data[0, ])
142+
meta_data[, `:=`("(row)" = numeric(), rowId = integer())]
143+
data.table::setcolorder(meta_data, neworder = c("(row)", "rowId"), before = 1)
144+
columns <- .mapply(
145+
get_column_def,
146+
list(full_cols, fields, meta_data),
147+
NULL
148+
)
149+
return(list(
150+
columns = columns,
151+
rows = list(),
152+
totalRows = .nrow,
153+
totalUnfiltered = .nrow
154+
))
155+
}
136156

137-
if ((!is.null(fd$type) && !is.null(fd$filter))) {
157+
if (is.null(cache_raw_dt[[key]]) || force) {
138158

139-
op <- fd$type
140-
raw <- if (fd$filterType == "date") fd$dateFrom else fd$filter
159+
dt0 <- data.table::as.data.table(data)
160+
dt0[, `:=`("(row)" = numeric(), rowId = .I)]
161+
data.table::setcolorder(dt0, neworder = c("(row)", "rowId"), before = 1)
141162

142-
# quote or coerce the filter literal
143-
lit <- if (inherits(data[[col_name]], "Date")) {
144-
sprintf('as.Date("%s")', raw)
145-
} else if (is.numeric(data[[col_name]])) {
146-
as.numeric(raw)
147-
} else if (is.logical(data[[col_name]])) {
148-
as.logical(raw)
149-
} else {
150-
sprintf('"%s"', gsub('"', '\\\\"', raw))
151-
}
163+
cache_raw_dt[[key]] <<- dt0
164+
cache_filtered_dt[[key]] <<- NULL
165+
cache_dt[[key]] <<- NULL
166+
cache_nrow[[key]] <<- .nrow
167+
cache_colnames[[key]] <<- full_cols
168+
cache_fields[[key]] <<- fields
169+
last_fm[[key]] <<- NULL
170+
last_sm[[key]] <<- NULL
171+
}
152172

153-
# build the right comparison or string test
154-
expr <- switch(op,
155-
equals = sprintf('get("%s") == %s', col_name, lit),
156-
notEqual = sprintf('get("%s") != %s', col_name, lit),
157-
greaterThan = sprintf('get("%s") > %s', col_name, lit),
158-
greaterThanOrEqual = sprintf('get("%s") >= %s', col_name, lit),
159-
lessThan = sprintf('get("%s") < %s', col_name, lit),
160-
lessThanOrEqual = sprintf('get("%s") <= %s', col_name, lit),
161-
contains = sprintf('grepl(%s, get("%s"), fixed=TRUE)', lit, col_name),
162-
notContains = sprintf('!grepl(%s, get("%s"), fixed=TRUE)', lit, col_name),
163-
startsWith = sprintf('startsWith(get("%s"), %s)', col_name, lit),
164-
endsWith = sprintf('endsWith(get("%s"), %s)', col_name, lit),
165-
regexp = sprintf('grepl(%s, get("%s"))', lit, col_name),
166-
blank = sprintf('is.na(get("%s")) | get("%s") == ""', col_name, col_name),
167-
notBlank = sprintf('!is.na(get("%s")) & get("%s") != ""', col_name, col_name),
168-
inRange = {
169-
hi <- if (inherits(data[[col_name]], "Date") && !is.null(fd$dateTo)) {
170-
sprintf('as.Date("%s")', fd$dateTo)
173+
if (is.null(cache_filtered_dt[[key]]) || !identical(filterModel, last_fm[[key]])) {
174+
175+
dt1 <- cache_raw_dt[[key]]
176+
177+
if (!is.null(filterModel) && length(filterModel) > 0) {
178+
filter_strings <- lapply(names(filterModel), function(fld) {
179+
fd <- filterModel[[fld]]
180+
col_name <- field_map[[fld]]
181+
if (!is.null(fd$type) && !is.null(fd$filter)) {
182+
op <- fd$type
183+
raw <- if (fd$filterType == "date") fd$dateFrom else fd$filter
184+
lit <- if (inherits(dt1[[col_name]], "Date")) {
185+
sprintf('as.Date("%s")', raw)
186+
} else if (is.numeric(dt1[[col_name]])) {
187+
as.numeric(raw)
188+
} else if (is.logical(dt1[[col_name]])) {
189+
as.logical(raw)
171190
} else {
172-
as.numeric(fd$filterTo)
191+
sprintf('"%s"', gsub('"', '\\\"', raw))
173192
}
174-
sprintf('get("%s") >= %s & get("%s") <= %s',
175-
col_name, lit, col_name, hi)
176-
},
193+
expr <- switch(op,
194+
equals = sprintf("%s == %s", col_name, lit),
195+
notEqual = sprintf("%s != %s", col_name, lit),
196+
greaterThan = sprintf("%s > %s", col_name, lit),
197+
greaterThanOrEqual = sprintf("%s >= %s", col_name, lit),
198+
lessThan = sprintf("%s < %s", col_name, lit),
199+
lessThanOrEqual = sprintf("%s <= %s", col_name, lit),
200+
contains = sprintf("grepl(%s, %s, fixed=TRUE)", lit, col_name),
201+
notContains = sprintf("!grepl(%s, %s, fixed=TRUE)", lit, col_name),
202+
startsWith = sprintf("startsWith(%s, %s)", col_name, lit),
203+
endsWith = sprintf("endsWith(%s, %s)", col_name, lit),
204+
regexp = sprintf("grepl(%s, %s)", lit, col_name),
205+
blank = sprintf('is.na(%s) | %s == ""', col_name, col_name),
206+
notBlank = sprintf('!is.na(%s) & %s != ""', col_name, col_name),
207+
inRange = {
208+
hi <- if (inherits(dt1[[col_name]], "Date") && !is.null(fd$dateTo)) {
209+
sprintf('as.Date("%s")', fd$dateTo)
210+
} else {
211+
as.numeric(fd$filterTo)
212+
}
213+
sprintf("%s >= %s & %s <= %s", col_name, lit, col_name, hi)
214+
},
215+
NULL
216+
)
217+
return(expr)
218+
}
177219
NULL
178-
)
179-
return(expr)
220+
})
221+
filter_strings <- Filter(Negate(is.null), filter_strings)
222+
if (length(filter_strings) > 0) {
223+
combined <- paste(filter_strings, collapse = " & ")
224+
dt1 <- dt1[eval(parse(text = combined))]
225+
}
180226
}
181-
NULL
182-
})
183-
184-
filter_strings <- Filter(Negate(is.null), filter_strings)
185-
# combine with &&
186-
if (length(filter_strings) > 0) {
187-
combined <- paste(filter_strings, collapse = " & ")
188-
data <- data[eval(parse(text = combined))]
227+
cache_filtered_dt[[key]] <<- dt1
189228
}
190-
}
191229

192-
nFiltered <- nrow(data)
230+
if (is.null(cache_dt[[key]])
231+
|| !identical(sortModel, last_sm[[key]])
232+
|| !identical(filterModel, last_fm[[key]])) {
193233

194-
if (!is.null(sortModel) && length(sortModel) > 0) {
234+
dt2 <- cache_filtered_dt[[key]]
235+
if (!is.null(sortModel) && length(sortModel) > 0) {
236+
cols <- vapply(sortModel, function(s) field_map[[s$colId]], FUN.VALUE = "")
237+
ords <- vapply(sortModel, function(s) if (s$sort == "asc") 1L else -1L, FUN.VALUE = integer(1))
238+
sorted <- data.table::copy(dt2)
239+
data.table::setorderv(sorted, cols, order = ords)
240+
} else {
241+
sorted <- dt2
242+
}
195243

196-
cols <- vapply(sortModel, function(s) field_map[[s$colId]], FUN.VALUE = "")
197-
ords <- vapply(sortModel, function(s) if (s$sort == "asc") 1L else -1L, FUN.VALUE = integer(1))
244+
cache_dt[[key]] <<- sorted
245+
last_sm[[key]] <<- sortModel
246+
last_fm[[key]] <<- filterModel
247+
}
198248

199-
data.table::setorderv(data, cols, order = ords)
200-
}
249+
# Fetch rows
250+
out_dt <- cache_dt[[key]]
251+
totalUnfiltered <- cache_nrow[[key]]
252+
totalRows <- nrow(out_dt)
201253

202-
if (is.null(end)) end <- nFiltered
203-
s <- as.integer(start) + 1
204-
e <- min(nFiltered, as.integer(end))
254+
if (is.null(end)) end <- totalRows
255+
s <- max(1L, as.integer(start) + 1)
256+
e <- min(totalRows, as.integer(end))
205257

206-
if (s > nFiltered || e < 1 || s > e) {
207-
rows <- data[0]
208-
} else {
209-
rows <- data[s:e][, "(row)" := s:e]
210-
}
258+
if (s > totalRows || e < 1 || s > e) {
259+
rows <- out_dt[0]
260+
} else {
261+
rows <- out_dt[s:e]
262+
rows[, "(row)" := seq.int(s, e)]
263+
}
211264

212-
names(rows) <- fields
213-
class(rows) <- "data.frame"
214-
attr(rows, "row.names") <- .set_row_names(nrow(rows))
265+
names(rows) <- cache_fields[[key]]
215266

216-
columns <- .mapply(
217-
get_column_def,
218-
list(.colnames, fields, rows),
219-
NULL
220-
)
267+
columns <- .mapply(
268+
get_column_def,
269+
list(cache_colnames[[key]], cache_fields[[key]], rows),
270+
NULL
271+
)
221272

222-
list(
223-
columns = columns,
224-
rows = rows,
225-
totalRows = nFiltered,
226-
totalUnfiltered = .nrow
227-
)
228-
}
273+
list(
274+
columns = columns,
275+
rows = rows,
276+
totalRows = totalRows,
277+
totalUnfiltered = totalUnfiltered
278+
)
279+
}
280+
})
229281

230282
if (use_webserver) {
231283
if (requireNamespace("httpuv", quietly = TRUE)) {
@@ -282,8 +334,24 @@ if (use_webserver) {
282334
}
283335
},
284336
dataview_fetch_rows = function(varname, start, end, sortModel, filterModel, ...) {
285-
obj <- get(varname, envir = .GlobalEnv)
286-
out <- dataview_table(obj, start, end, sortModel, filterModel)
337+
338+
if (!exists(".dataview_first_map", envir = .GlobalEnv, inherits = FALSE)) {
339+
assign(".dataview_first_map", new.env(parent = emptyenv()), envir = .GlobalEnv)
340+
}
341+
fm_env <- get(".dataview_first_map", envir = .GlobalEnv)
342+
343+
obj <- if (exists(varname, envir = .GlobalEnv)) {
344+
get(varname, envir = .GlobalEnv)
345+
} else {
346+
eval(parse(text = varname), envir = .GlobalEnv)
347+
}
348+
349+
attr(obj, "_dvkey") <- varname
350+
351+
is_first <- is.null(fm_env[[varname]])
352+
fm_env[[varname]] <- TRUE
353+
354+
out <- dataview_table(obj, start, end, sortModel, filterModel, force = is_first)
287355
out$columns <- NULL
288356
return(out)
289357
}
@@ -712,14 +780,18 @@ if (show_view) {
712780
}
713781
}
714782
if (is.data.frame(x) || is.matrix(x)) {
783+
expr_text <- deparse1(substitute(x))
715784
x <- as_truncated_data(x)
716-
# Get initial chunk of data (first 100 rows)
717-
meta <- dataview_table(x, start = 0, end = 1)
718-
meta$rows <- list()
785+
if (exists(".dataview_first_map", envir = .GlobalEnv, inherits = FALSE)) {
786+
fm_env <- get(".dataview_first_map", envir = .GlobalEnv)
787+
fm_env[[title]] <- NULL
788+
}
789+
meta <- dataview_table(x, start = 0, end = 0, metadata_only = TRUE, force = TRUE)
719790
file <- tempfile(tmpdir = tempdir, fileext = ".json")
720791
jsonlite::write_json(meta, file, na = "string", null = "null", auto_unbox = TRUE, force = TRUE)
721792
request("dataview", source = "table", type = "json",
722-
title = title, file = file, viewer = viewer, uuid = uuid, dataview_uuid = dataview_uuid
793+
title = title, file = file, viewer = viewer,
794+
uuid = uuid, dataview_uuid = dataview_uuid, expr = expr_text
723795
)
724796
} else if (is.list(x)) {
725797
tryCatch({

‎src/liveShare/shareSession.ts‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ export interface IRequest {
2727
source?: string;
2828
type?: string;
2929
title?: string;
30+
expr?: string;
3031
file?: string;
3132
viewer?: string;
3233
plot?: string;
@@ -150,7 +151,8 @@ export async function updateGuestRequest(file: string, force: boolean = false):
150151
if (request.source && request.type && request.title && request.file
151152
&& request.viewer !== undefined) {
152153
await showDataView(request.source,
153-
request.type, request.title, request.file, request.viewer, request.dataview_uuid);
154+
request.type, request.title, request.file, request.viewer, request.dataview_uuid,
155+
request.expr);
154156
}
155157
break;
156158
}

0 commit comments

Comments
 (0)