WIP: Enhance data viewer

R/init.R

@@ -64,6 +64,7 @@ init_last <- function() {
     .vsc.browser <- .vsc$show_browser
     .vsc.viewer <- .vsc$show_viewer
     .vsc.page_viewer <- .vsc$show_page_viewer
+    .vsc.get_rows <- .vsc$get_rows
 
     # assign functions that are optional:
     for (funcName in c("View", ".External.graphics")) {

R/vsc.R

@@ -230,64 +230,31 @@ if (show_view) {
     }
   }
 
-  dataview_table <- function(data) {
-    if (is.data.frame(data)) {
-      nrow <- nrow(data)
-      colnames <- colnames(data)
-      if (is.null(colnames)) {
-        colnames <- sprintf("(X%d)", seq_len(ncol(data)))
-      } else {
-        colnames <- trimws(colnames)
-      }
-      if (.row_names_info(data) > 0L) {
-        rownames <- rownames(data)
-        rownames(data) <- NULL
-      } else {
-        rownames <- seq_len(nrow)
-      }
-      data <- c(list(" " = rownames), .subset(data))
-      colnames <- c(" ", colnames)
-      types <- vapply(data, dataview_data_type,
-        character(1L), USE.NAMES = FALSE)
-      data <- vapply(data, function(x) {
-        trimws(format(x))
-      }, character(nrow), USE.NAMES = FALSE)
-      dim(data) <- c(length(rownames), length(colnames))
-    } else if (is.matrix(data)) {
-      if (is.factor(data)) {
-        data <- format(data)
-      }
-      types <- rep(dataview_data_type(data), ncol(data))
-      colnames <- colnames(data)
-      colnames(data) <- NULL
-      if (is.null(colnames)) {
-        colnames <- sprintf("(X%d)", seq_len(ncol(data)))
-      } else {
-        colnames <- trimws(colnames)
-      }
-      rownames <- rownames(data)
-      rownames(data) <- NULL
-      data <- trimws(format(data))
-      if (is.null(rownames)) {
-        types <- c("num", types)
-        rownames <- seq_len(nrow(data))
-      } else {
-        types <- c("string", types)
-        rownames <- trimws(rownames)
-      }
-      dim(data) <- c(length(rownames), length(colnames))
-      colnames <- c(" ", colnames)
-      data <- cbind(rownames, data)
+  dataview_table_info <- function(data) {
+    if (is.matrix(data)) {
+      data <- as.data.frame(data)
+    } else if (is.data.frame(data)) {
     } else {
       stop("data must be data.frame or matrix")
     }
-    columns <- .mapply(function(title, type) {
-      class <- if (type == "string") "text-left" else "text-right"
-      list(title = scalar(title),
-        className = scalar(class),
-        type = scalar(type))
-    }, list(colnames, types), NULL)
-    list(columns = columns, data = data)
+
+    iDataFrameInfoColumnType <- function(column) {
+        switch(typeof(column),
+        "integer" = "num",
+        "double" = "num",
+        "logical" = "bool",
+        "string")
+    }
+
+    columns  <- data.frame(
+      key = names(data),
+      type = unname(sapply(data, iDataFrameInfoColumnType))
+    )
+
+    list(columns = columns,
+        rowCount = nrow(data),
+        shape = dim(data),
+        type = class(data)[1])
   }
 
   show_dataview <- function(x, title,
@@ -350,9 +317,16 @@ if (show_view) {
       }
     }
     if (is.data.frame(x) || is.matrix(x)) {
-      data <- dataview_table(x)
-      file <- tempfile(tmpdir = tempdir, fileext = ".json")
-      jsonlite::write_json(data, file, matrix = "rowmajor")
+      file <- tempfile(tmpdir = tempdir)
+      data_info <- c(
+        dataview_table_info(x),
+        name = deparse(substitute(x)),
+        fileName = file)
+      jsonlite::write_json(
+        data_info,
+        path = paste0(file, "_info.json"),
+        auto_unbox = TRUE,
+        matrix = "rowmajor")
       request("dataview", source = "table", type = "json",
         title = title, file = file, viewer = viewer)
     } else if (is.list(x)) {
@@ -622,6 +596,31 @@ print.hsearch <- function(x, ...) {
   invisible(x)
 }
 
+get_rows <- function(start, end, object, file) {
+
+  message("getting row ",
+    format(start, scientific = FALSE),
+    " to ",
+    format(end, scientific = FALSE),
+    " for View(",
+    deparse(substitute(object)),
+    ")")
+
+  if (is.matrix(object)) {
+      object <- as.data.frame(object)
+  }
+
+  jsonlite::write_json(
+    object[start:end, ],
+    path = paste0(file,
+                  "_rows_",
+                  format(start, scientific = FALSE),
+                  "_to_",
+                  format(end, scientific = FALSE),
+                  ".json")
+  )
+}
+
 # a copy of .S3method(), since this function is new in R 4.0
 .S3method <- function(generic, class, method) {
   if (missing(method)) {