Class-TableCollection.R

#' @title Table collection R6 class (TableCollection)
#' @description An R6 class holding an external pointer to a table collection
#' object. As an R6 class, its methods look Pythonic and therefore resemble the
#' tskit Python API. Since the class only holds the pointer, it is lightweight.
#' Currently there is a limited set of R methods for working the tree sequence.
#' @export
TableCollection <- R6Class(
  classname = "TableCollection",
  public = list(
    #' @field xptr external pointer to the table collection
    xptr = "externalptr",

    #' @description Create a \code{\link{TableCollection}} from a file or an external pointer.
    #' @param file a string specifying the full path of the tree sequence file.
    #' @param skip_tables logical; if \code{TRUE}, load only non-table information.
    #' @param skip_reference_sequence logical; if \code{TRUE}, skip loading
    #'   reference genome sequence information.
    #' @param xptr an external pointer (\code{externalptr}) to a table collection.
    #' @details See the corresponding Python function at
    #'   \url{https://github.com/tskit-dev/tskit/blob/dc394d72d121c99c6dcad88f7a4873880924dd72/python/tskit/tables.py#L3463}.
    #'   TODO: Update URL to TableCollection.load() method #104
    #'         https://github.com/HighlanderLab/RcppTskit/issues/104
    #' @return A \code{\link{TableCollection}} object.
    #' @examples
    #' ts_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- TableCollection$new(file = ts_file)
    #' is(tc)
    #' tc
    initialize = function(
      file,
      skip_tables = FALSE,
      skip_reference_sequence = FALSE,
      xptr = NULL
    ) {
      if (missing(file) && is.null(xptr)) {
        stop("Provide a file or an external pointer (xptr)!")
      }
      if (!missing(file) && !is.null(xptr)) {
        stop(
          "Provide either a file or an external pointer (xptr), but not both!"
        )
      }
      if (!missing(file)) {
        if (!is.character(file)) {
          stop("file must be a character string!")
        }
        options <- load_args_to_options(
          skip_tables = skip_tables,
          skip_reference_sequence = skip_reference_sequence
        )
        self$xptr <- rtsk_table_collection_load(
          filename = file,
          options = options
        )
      } else {
        if (!is.null(xptr) && !is(xptr, "externalptr")) {
          stop(
            "external pointer (xptr) must be an object of externalptr class!"
          )
        }
        self$xptr <- xptr
      }
      invisible(self)
    },

    #' @description Write a table collection to a file.
    #' @param file a string specifying the full path of the tree sequence file.
    #' @details See the corresponding Python function at
    #'   \url{https://tskit.dev/tskit/docs/latest/python-api.html#tskit.TableCollection.dump}.
    #' @return No return value; called for side effects.
    #' @examples
    #' ts_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- TableCollection$new(file = ts_file)
    #' dump_file <- tempfile()
    #' tc$dump(dump_file)
    #' tc$write(dump_file) # alias
    #' \dontshow{file.remove(dump_file)}
    dump = function(file) {
      rtsk_table_collection_dump(self$xptr, filename = file, options = 0L)
    },

    #' @description Alias for \code{\link[=TableCollection]{TableCollection$dump}}.
    #' @param file see \code{\link[=TableCollection]{TableCollection$dump}}.
    write = function(file) {
      self$dump(file = file)
    },

    #' @description Create a \code{\link{TreeSequence}} from this table collection.
    #' @details See the corresponding Python function at
    #'   \url{https://tskit.dev/tskit/docs/latest/python-api.html#tskit.TableCollection.tree_sequence}.
    #' @return A \code{\link{TreeSequence}} object.
    #' @examples
    #' ts_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- TableCollection$new(file = ts_file)
    #' ts <- tc$tree_sequence()
    #' is(ts)
    tree_sequence = function() {
      if (!self$has_index()) {
        self$build_index()
      }
      ts_xptr <- rtsk_treeseq_init(self$xptr)
      TreeSequence$new(xptr = ts_xptr)
    },

    #' @description Get the sequence length.
    #' @examples
    #' tc_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(tc_file)
    #' tc$sequence_length()
    sequence_length = function() {
      rtsk_table_collection_get_sequence_length(self$xptr)
    },

    #' @description Get the time units string.
    #' @examples
    #' tc_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(tc_file)
    #' tc$time_units()
    time_units = function() {
      rtsk_table_collection_get_time_units(self$xptr)
    },

    #' @description Get whether the table collection has edge indexes.
    #' @examples
    #' tc_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(tc_file)
    #' tc$has_index()
    has_index = function() {
      rtsk_table_collection_has_index(self$xptr)
    },

    #' @description Build edge indexes for this table collection.
    #' @details See the corresponding Python function at
    #'   \url{https://tskit.dev/tskit/docs/latest/python-api.html#tskit.TableCollection.build_index}.
    #' @return No return value; called for side effects.
    #' @examples
    #' tc_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(tc_file)
    #' tc$has_index()
    #' tc$drop_index()
    #' tc$has_index()
    #' tc$build_index()
    #' tc$has_index()
    build_index = function() {
      rtsk_table_collection_build_index(self$xptr)
    },

    #' @description Drop edge indexes for this table collection.
    #' @details See the corresponding Python function at
    #'   \url{https://tskit.dev/tskit/docs/latest/python-api.html#tskit.TableCollection.drop_index}.
    #' @return No return value; called for side effects.
    #' @examples
    #' tc_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(tc_file)
    #' tc$has_index()
    #' tc$drop_index()
    #' tc$has_index()
    drop_index = function() {
      rtsk_table_collection_drop_index(self$xptr)
    },

    #' @description Get whether the table collection has a reference genome sequence.
    #' @examples
    #' tc_file1 <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc_file2 <- system.file("examples/test_with_ref_seq.trees", package = "RcppTskit")
    #' tc1 <- tc_load(tc_file1)
    #' tc1$has_reference_sequence()
    #' tc2 <- tc_load(tc_file2)
    #' tc2$has_reference_sequence()
    has_reference_sequence = function() {
      rtsk_table_collection_has_reference_sequence(self$xptr)
    },

    #' @description Get the file UUID string.
    #' @details Returns the UUID of the file the table collection was loaded from.
    #'   If unavailable, returns \code{NA_character_}.
    #' @examples
    #' tc_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(tc_file)
    #' tc$file_uuid()
    file_uuid = function() {
      rtsk_table_collection_get_file_uuid(self$xptr)
    },

    #' @description This function saves a table collection from R to disk and
    #'   loads it into reticulate Python for use with the \code{tskit} Python API.
    #' @param tskit_module reticulate Python module of \code{tskit}. By default,
    #'   it calls \code{\link{get_tskit_py}} to obtain the module.
    #' @param cleanup logical; delete the temporary file at the end of the function?
    #' @details See \url{https://tskit.dev/tutorials/tables_and_editing.html#tables-and-editing}
    #'   on what you can do with the tables.
    #' @return Table collection in reticulate Python.
    #' @seealso \code{\link{tc_py_to_r}}, \code{\link{tc_load}}, and
    #'   \code{\link[=TableCollection]{TableCollection$dump}}.
    #' @examples
    #' \dontrun{
    #'   ts_file <- system.file("examples/test.trees", package = "RcppTskit")
    #'   tc_r <- tc_load(ts_file)
    #'   is(tc_r)
    #'   tc_r$print()
    #'
    #'   # Transfer the table collection to reticulate Python and use tskit Python API
    #'   tskit <- get_tskit_py()
    #'   if (check_tskit_py(tskit)) {
    #'     tc_py <- tc_r$r_to_py()
    #'     is(tc_py)
    #'     tmp <- tc_py$simplify(samples = c(0L, 1L, 2L, 3L))
    #'     tmp
    #'     tc_py$individuals$num_rows # 2
    #'     tc_py$nodes$num_rows # 8
    #'     tc_py$nodes$time # 0.0 ... 5.0093910
    #'   }
    #' }
    r_to_py = function(tskit_module = get_tskit_py(), cleanup = TRUE) {
      rtsk_table_collection_r_to_py(
        self$xptr,
        tskit_module = tskit_module,
        cleanup = cleanup
      )
    },

    #' @description Print a summary of a table collection and its contents.
    #' @return A list with two data.frames; the first contains table collection
    #'   properties and their values; the second contains the number of rows in
    #'   each table and the length of their metadata.
    #' @examples
    #' ts_file <- system.file("examples/test.trees", package = "RcppTskit")
    #' tc <- tc_load(file = ts_file)
    #' tc$print()
    #' tc
    print = function() {
      ret <- rtsk_table_collection_print(self$xptr)
      # These are not hit since testing is not interactive
      # nocov start
      if (interactive()) {
        cat("Object of class 'TableCollection'\n")
        print(ret)
      }
      # nocov end
      invisible(ret)
    }
  )
)