R/named_MM.R

In ReDaMoR: Relational Data Modeler

###############################################################################@
#' Identify if a file is in MatrixMarket text format
#'
#' @param file the file to read
#'
#' @return A logical. If FALSE, the first line of the file is returned as
#' an attribute named "r1": `attr(is_MM, "r1")`
#'
#' @export
#'
is_MM <- function(file){
   r1 <- readLines(file, n=1)
   sms <- "%%MatrixMarket"
   toRet <- substr(r1, 1, nchar(sms))==sms
   if(!toRet){
      attr(toRet, "r1") <- r1
   }
   return(toRet)
}


###############################################################################@
#' Read the header of a named sparse matrix in MatrixMarket text format
#'
#' @param file the file to read
#' @param guess_max the number of lines to read to find the header.
#' (4 should be sufficient. Default: 20)
#'
#' @return A list with the following fields:
#' - rownames: a character vector with the matrix row names
#' - colnames: a character vector with the matrix column names
#' - rows: the number of matrix rows
#' - columns: the number of matrix columns
#' - values: the number of values in the matrix
#' - header_length: the number of lines in the header
#'
#' @export
#'
read_named_MM_header <- function(file, guess_max=20){
   h <- readLines(file, n=guess_max)
   rn <- strsplit(
      sub("^%%Rownames: ", "", h[grep("^%%Rownames: ", h)]),
      split="\t"
   )[[1]]
   cn <- strsplit(
      sub("^%%Colnames: ", "", h[grep("^%%Colnames: ", h)]),
      split="\t"
   )[[1]]
   hl <- grep("^%%", h, invert=TRUE)[1]
   n <- as.numeric(strsplit(
      h[hl],
      split=" "
   )[[1]])
   nr <- n[1]
   nc <- n[2]
   nv <- n[3]
   stopifnot(nr==length(rn), nc==length(cn))
   return(list(
      rownames=rn,
      colnames=cn,
      rows=nr,
      columns=nc,
      values=nv,
      header_length=hl
   ))
}

###############################################################################@
#' Read a named sparse matrix in MatrixMarket text format
#'
#' @param file the file to read
#' @param skip the number of records to skip (default: 0)
#' @param n_max the maximum number of records to read (default: Inf)
#' @param class the class of object to return. By default a "dgCMatrix".
#' If "tibble" is chosen, the sparse matrix is returned as a tibble with
#' 3 columns: i (row index), j (column index) and x (values) and
#' an "header" attribute containing the matrix rownames and colnames.
#' @param guess_max the number of lines to read to find the header.
#' (see [read_named_MM_header()])
#'
#' @return By default a dgCMatrix.
#' If the "tibble" class is chosen, the sparse matrix is returned as
#' a tibble with 3 columns: i (row index), j (column index) and x (values) and
#' an "header" attribute containing the matrix rownames and colnames.
#'
#' @export
#'
read_named_MM <- function(
   file, skip=0, n_max=Inf,
   class=c("dgCMatrix", "tibble"),
   guess_max=20
){
   class <- match.arg(class)
   h <- read_named_MM_header(file, guess_max=guess_max)

   ## The following chunck is about dealing with many rownames or colnames
   ## in gz compressed files
   ovcs <- Sys.getenv("VROOM_CONNECTION_SIZE")
   on.exit(Sys.setenv("VROOM_CONNECTION_SIZE"=ovcs))
   Sys.setenv(
      "VROOM_CONNECTION_SIZE"=max(
         c(
            utils::object.size(h$rownames), utils::object.size(h$colnames),
            as.numeric(ovcs)
         ),
         na.rm=TRUE
      )
   )
   ##

   td <- readr::read_delim(
      file, delim="\t",
      col_names=c("i", "j", "x"),
      col_types="iin",
      skip=h$header_length+skip, n_max=n_max
   )
   if(class=="dgCMatrix"){
      toRet <- Matrix::sparseMatrix(
         i=td$i, j=td$j, x=td$x,
         dimnames=list(h$rownames[1:max(td$i)], h$colnames[1:max(td$j)])
      )
   }
   if(class=="tibble"){
      toRet <- td
      attr(toRet, "header") <- h
   }
   return(toRet)
}