Add support for array schema evolution

NAMESPACE

@@ -80,6 +80,10 @@ export(tiledb_array_open)
 export(tiledb_array_open_at)
 export(tiledb_array_schema)
 export(tiledb_array_schema_check)
+export(tiledb_array_schema_evolution)
+export(tiledb_array_schema_evolution_add_attribute)
+export(tiledb_array_schema_evolution_array_evolve)
+export(tiledb_array_schema_evolution_drop_attribute)
 export(tiledb_array_schema_get_allows_dups)
 export(tiledb_array_schema_get_capacity)
 export(tiledb_array_schema_set_allows_dups)
@@ -231,6 +235,7 @@ export(tiledb_vfs_write)
 export(toSparseMatrix)
 exportClasses(tiledb_array)
 exportClasses(tiledb_array_schema)
+exportClasses(tiledb_array_schema_evolution)
 exportClasses(tiledb_attr)
 exportClasses(tiledb_config)
 exportClasses(tiledb_ctx)

R/ArraySchemaEvolution.R

@@ -0,0 +1,84 @@
+#  MIT License
+#
+#  Copyright (c) 2021 TileDB Inc.
+#
+#  Permission is hereby granted, free of charge, to any person obtaining a copy
+#  of this software and associated documentation files (the "Software"), to deal
+#  in the Software without restriction, including without limitation the rights
+#  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+#  copies of the Software, and to permit persons to whom the Software is
+#  furnished to do so, subject to the following conditions:
+#
+#  The above copyright notice and this permission notice shall be included in all
+#  copies or substantial portions of the Software.
+#
+#  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+#  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+#  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+#  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+#  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+#  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+#  SOFTWARE.
+
+#' An S4 class for a TileDB ArraySchemaEvolution object
+#'
+#' @slot ptr An external pointer to the underlying implementation
+#' @exportClass tiledb_array_schema_evolution
+setClass("tiledb_array_schema_evolution",
+         slots = list(ptr = "externalptr"))
+
+#' Creates a 'tiledb_array_schema_evolution' object
+#'
+#' @param ctx (optional) A TileDB Ctx object; if not supplied the default
+#' context object is retrieved
+#' @return A 'array_schema_evolution' object
+#' @export
+tiledb_array_schema_evolution <- function(ctx = tiledb_get_context()) {
+    stopifnot(`The 'ctx' argument must be a Context object` = is(ctx, "tiledb_ctx"),
+              `This function needs TileDB 2.4.0 or newer` = tiledb_version(TRUE) >= "2.4.0")
+    ptr <- libtiledb_array_schema_evolution(ctx@ptr)
+    array_schema_evolution <- new("tiledb_array_schema_evolution", ptr = ptr)
+    invisible(array_schema_evolution)
+}
+
+#' Add an Attribute to a TileDB Array Schema Evolution object
+#'
+#' @param object A TileDB 'array_schema_evolution' object
+#' @param attr A TileDB attribute
+#' @return The modified 'array_schema_evolution' object, invisibly
+#' @export
+tiledb_array_schema_evolution_add_attribute <- function(object, attr) {
+    stopifnot(`The first argument must be a Array Schema Evolution object` =
+                  is(object, "tiledb_array_schema_evolution"),
+              `The 'attr' argument must be an Attribute object` = is(attr, "tiledb_attr"))
+    object@ptr <- libtiledb_array_schema_evolution_add_attribute(object@ptr, attr@ptr)
+    invisible(object)
+}
+
+#' Drop an attribute given by name from a TileDB Array Schema Evolution object
+#'
+#' @param object A TileDB 'array_schema_evolution' object
+#' @param attrname A character variable with an attribute name
+#' @return The modified 'array_schema_evolution' object, invisibly
+#' @export
+tiledb_array_schema_evolution_drop_attribute <- function(object, attrname) {
+    stopifnot(`The first argument must be a Array Schema Evolution object` =
+                  is(object, "tiledb_array_schema_evolution"),
+              `The 'attrname' argument must be character variable` = is.character(attrname))
+    object@ptr <- libtiledb_array_schema_evolution_drop_attribute(object@ptr, attrname)
+    invisible(object)
+}
+
+#' Evolve an Array Schema
+#'
+#' @param object A TileDB 'array_schema_evolution' object
+#' @param uri A character variable with an URI
+#' @return The modified 'array_schema_evolution' object, invisibly
+#' @export
+tiledb_array_schema_evolution_array_evolve <- function(object, uri) {
+    stopifnot(`The first argument must be a Array Schema Evolution object` =
+                  is(object, "tiledb_array_schema_evolution"),
+              `The 'uri' argument must be character variable` = is.character(uri))
+    object@ptr <- libtiledb_array_schema_evolution_array_evolve(object@ptr, uri)
+    invisible(object)
+}

R/RcppExports.R

@@ -385,6 +385,22 @@ libtiledb_array_schema_check <- function(schema) {
     .Call(`_tiledb_libtiledb_array_schema_check`, schema)
 }
 
+libtiledb_array_schema_evolution <- function(ctx) {
+    .Call(`_tiledb_libtiledb_array_schema_evolution`, ctx)
+}
+
+libtiledb_array_schema_evolution_add_attribute <- function(ase, attr) {
+    .Call(`_tiledb_libtiledb_array_schema_evolution_add_attribute`, ase, attr)
+}
+
+libtiledb_array_schema_evolution_drop_attribute <- function(ase, attrname) {
+    .Call(`_tiledb_libtiledb_array_schema_evolution_drop_attribute`, ase, attrname)
+}
+
+libtiledb_array_schema_evolution_array_evolve <- function(ase, uri) {
+    .Call(`_tiledb_libtiledb_array_schema_evolution_array_evolve`, ase, uri)
+}
+
 libtiledb_array_create <- function(uri, schema) {
     .Call(`_tiledb_libtiledb_array_create`, uri, schema)
 }

inst/include/tiledb.h

@@ -3,6 +3,9 @@
 #define TILEDB_DEPRECATED
 
 #include <tiledb/tiledb>
+#if TILEDB_VERSION_MAJOR == 2 && TILEDB_VERSION_MINOR >= 4
+#include <tiledb/tiledb_experimental>
+#endif
 
 #define STRICT_R_HEADERS
 #include "Rcpp.h"
@@ -68,6 +71,14 @@ struct vfs_fh {
 };
 typedef struct vfs_fh vfs_fh_t;
 
+#if TILEDB_VERSION_MAJOR == 2 && TILEDB_VERSION_MINOR < 2
+// we need a placeholder as tiledb::FragmentInfo is in function signatures
+namespace tiledb {
+    class FragmentInfo {
+    };
+}
+#endif
+
 #if TILEDB_VERSION_MAJOR == 2 && TILEDB_VERSION_MINOR < 3
 // we need a placeholder as tiledb::QueryCondition is in at least one function signature
 namespace tiledb {
@@ -76,10 +87,10 @@ namespace tiledb {
 }
 #endif
 
-#if TILEDB_VERSION_MAJOR == 2 && TILEDB_VERSION_MINOR < 2
-// we need a placeholder as tiledb::FragmentInfo is in function signatures
+#if TILEDB_VERSION_MAJOR == 2 && TILEDB_VERSION_MINOR < 4
+// we need a placeholder as tiledb::ArraySchemaEvolution is in function signatures
 namespace tiledb {
-    class FragmentInfo {
+    class ArraySchemaEvolution {
     };
 }
 #endif

inst/tinytest/test_arrayschemaevolution.R

@@ -0,0 +1,30 @@
+library(tinytest)
+library(tiledb)
+
+isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion)
+
+ctx <- tiledb_ctx(limitTileDBCores())
+
+if (tiledb_version(TRUE) < "2.4.0") exit_file("Needs TileDB 2.4.* or later")
+
+df <- data.frame(key=letters[1:10],
+                 val=1:10)
+uri <- tempfile()
+arr <- fromDataFrame(df, uri)
+
+ase <- tiledb_array_schema_evolution()
+attr <- tiledb_attr("foo", "INT32")
+ase <- tiledb_array_schema_evolution_add_attribute(ase, attr)
+ase <- tiledb_array_schema_evolution_array_evolve(ase, uri)
+arr <- tiledb_array(uri, return_as="data.frame", extended=FALSE)
+res <- arr[]
+expect_equal(dim(res), c(10,3))
+expect_equal(colnames(res), c("key", "val", "foo"))
+
+ase <- tiledb_array_schema_evolution()
+ase <- tiledb_array_schema_evolution_drop_attribute(ase, "val")
+ase <- tiledb_array_schema_evolution_array_evolve(ase, uri)
+arr <- tiledb_array(uri, return_as="data.frame", extended=FALSE)
+res <- arr[]
+expect_equal(dim(res), c(10,2))
+expect_equal(colnames(res), c("key", "foo"))

src/RcppExports.cpp

@@ -1125,6 +1125,53 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// libtiledb_array_schema_evolution
+XPtr<tiledb::ArraySchemaEvolution> libtiledb_array_schema_evolution(XPtr<tiledb::Context> ctx);
+RcppExport SEXP _tiledb_libtiledb_array_schema_evolution(SEXP ctxSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< XPtr<tiledb::Context> >::type ctx(ctxSEXP);
+    rcpp_result_gen = Rcpp::wrap(libtiledb_array_schema_evolution(ctx));
+    return rcpp_result_gen;
+END_RCPP
+}
+// libtiledb_array_schema_evolution_add_attribute
+XPtr<tiledb::ArraySchemaEvolution> libtiledb_array_schema_evolution_add_attribute(XPtr<tiledb::ArraySchemaEvolution> ase, XPtr<tiledb::Attribute> attr);
+RcppExport SEXP _tiledb_libtiledb_array_schema_evolution_add_attribute(SEXP aseSEXP, SEXP attrSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< XPtr<tiledb::ArraySchemaEvolution> >::type ase(aseSEXP);
+    Rcpp::traits::input_parameter< XPtr<tiledb::Attribute> >::type attr(attrSEXP);
+    rcpp_result_gen = Rcpp::wrap(libtiledb_array_schema_evolution_add_attribute(ase, attr));
+    return rcpp_result_gen;
+END_RCPP
+}
+// libtiledb_array_schema_evolution_drop_attribute
+XPtr<tiledb::ArraySchemaEvolution> libtiledb_array_schema_evolution_drop_attribute(XPtr<tiledb::ArraySchemaEvolution> ase, const std::string& attrname);
+RcppExport SEXP _tiledb_libtiledb_array_schema_evolution_drop_attribute(SEXP aseSEXP, SEXP attrnameSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< XPtr<tiledb::ArraySchemaEvolution> >::type ase(aseSEXP);
+    Rcpp::traits::input_parameter< const std::string& >::type attrname(attrnameSEXP);
+    rcpp_result_gen = Rcpp::wrap(libtiledb_array_schema_evolution_drop_attribute(ase, attrname));
+    return rcpp_result_gen;
+END_RCPP
+}
+// libtiledb_array_schema_evolution_array_evolve
+XPtr<tiledb::ArraySchemaEvolution> libtiledb_array_schema_evolution_array_evolve(XPtr<tiledb::ArraySchemaEvolution> ase, const std::string& uri);
+RcppExport SEXP _tiledb_libtiledb_array_schema_evolution_array_evolve(SEXP aseSEXP, SEXP uriSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< XPtr<tiledb::ArraySchemaEvolution> >::type ase(aseSEXP);
+    Rcpp::traits::input_parameter< const std::string& >::type uri(uriSEXP);
+    rcpp_result_gen = Rcpp::wrap(libtiledb_array_schema_evolution_array_evolve(ase, uri));
+    return rcpp_result_gen;
+END_RCPP
+}
 // libtiledb_array_create
 std::string libtiledb_array_create(std::string uri, XPtr<tiledb::ArraySchema> schema);
 RcppExport SEXP _tiledb_libtiledb_array_create(SEXP uriSEXP, SEXP schemaSEXP) {
@@ -2794,6 +2841,10 @@ static const R_CallMethodDef CallEntries[] = {
     {"_tiledb_libtiledb_array_schema_sparse", (DL_FUNC) &_tiledb_libtiledb_array_schema_sparse, 1},
     {"_tiledb_libtiledb_array_schema_dump", (DL_FUNC) &_tiledb_libtiledb_array_schema_dump, 1},
     {"_tiledb_libtiledb_array_schema_check", (DL_FUNC) &_tiledb_libtiledb_array_schema_check, 1},
+    {"_tiledb_libtiledb_array_schema_evolution", (DL_FUNC) &_tiledb_libtiledb_array_schema_evolution, 1},
+    {"_tiledb_libtiledb_array_schema_evolution_add_attribute", (DL_FUNC) &_tiledb_libtiledb_array_schema_evolution_add_attribute, 2},
+    {"_tiledb_libtiledb_array_schema_evolution_drop_attribute", (DL_FUNC) &_tiledb_libtiledb_array_schema_evolution_drop_attribute, 2},
+    {"_tiledb_libtiledb_array_schema_evolution_array_evolve", (DL_FUNC) &_tiledb_libtiledb_array_schema_evolution_array_evolve, 2},
     {"_tiledb_libtiledb_array_create", (DL_FUNC) &_tiledb_libtiledb_array_create, 2},
     {"_tiledb_libtiledb_array_create_with_key", (DL_FUNC) &_tiledb_libtiledb_array_create_with_key, 3},
     {"_tiledb_libtiledb_array_open", (DL_FUNC) &_tiledb_libtiledb_array_open, 3},

src/finalizers.h

@@ -180,6 +180,15 @@ extern "C" {
         }
     }
 
+    inline void libtiledb_arrayschemaevolution_delete(SEXP sexp) {
+        XPtr<tiledb::ArraySchemaEvolution> arr(sexp);
+        tiledb::ArraySchemaEvolution* ptr = arr.get();
+        if (ptr != nullptr) {
+            delete ptr;
+            ptr = nullptr;
+        }
+    }
+
 }
 
 #endif