R/read_kfamset.R

In kstIO: Knowledge Space Theory Input/Output

#' Read a family of sets from file
#'
#' @param filename Name of the file
#' @param format File format (default "auto")
#' @param as.letters How to name items (default TRUE)
#' @param header For spreadsheet files: does it include a header line (default TRUE)
#' @param sep Cell separator for CSV files (default ',')
#' @param enforce Do we enforce famset properties (default TRUE)?
#' @returns List with two elements \code{matrix} and \code{sets} containing the respective representations of the famset read
#' 
#' @examples
#' kstMatrix::xpl$basis
#' tempfile <- paste0(tempdir(), "/test.bas")
#' write_kbase(kstMatrix::xpl$basis, tempfile, format="KST")
#' read_kbase(tempfile)
#' 
#' @family Functions for reading and writing families of sets
#' 
#' @importFrom tools file_ext
#' @importFrom utils read.csv read.csv2 
#' @importFrom readODS read_ods
#' @importFrom openxlsx2 read_xlsx
#' @importFrom kstMatrix kmfamset
#' 
#' @export
read_kfamset <- function(filename, 
                       format="auto", 
                       as.letters = TRUE,
                       header = TRUE,
                       sep = ',',
                       enforce = TRUE
) {
  spreadsheet <- FALSE
  if (format == "auto") {
    ext <- tolower(file_ext(filename))
    if (ext == "csv") format <- "CSV"
    else if (ext == "xlsx") format <- "XLSX"
    else if (ext == "ods") format <- "ODS"
  }
  if (format == "CSV") {
    if (sep == ',') df <- read.csv(file=filename, header=header)
    else df <- read.csv2(file=filename, header=header)
    spreadsheet <- TRUE
  } else if (format == "XLSX") {
    if (header)
      df <- read_xlsx(filename)
    else {
      df <- read_xlsx(filename, col_names=FALSE)
      colnames(df) <- NULL
    }
    spreadsheet <- TRUE
  } else if (format == "ODS") {
    if (header)
      df <- read_ods(filename, progress=FALSE)
    else {
      df <- read_ods(filename, col_names=FALSE, progress=FALSE)
      colnames(df) <- NULL
    }
    spreadsheet <- TRUE
  } else {
    header <- FALSE
    f <- readLines(con=filename)
    if (length(f) == 0) {
      stop(sprintf("Unable to read file %s!", filename))
    }
    
    if (format == "KST") {
      noi <- as.numeric(f[1])
      if (noi <= 0)
        stop(sprintf("Invalid number of items in %s.", filename))
      nos <- as.numeric(f[2])
      if (nos <= 0)
        stop(sprintf("Invalid number of states in %s.", filename))
      offset <- 2
    }
    else if (format == "matrix") {
      noi <- nchar(f[1])
      nos <- length(f)
      offset <- 0
    }
    else {   # format == "auto"
      if (nchar(f[1]) == nchar(f[length(f)])) { # most probably matrix
        nos <- length(f)
        noi <- nchar(f[1])
        offset <- 0
      }
      else {    # Assuming KST format
        noi <- as.numeric(f[1])
        if (noi <= 0)
          stop(sprintf("Invalid number of items in %s.", filename))
        nos <- as.numeric(f[2])
        if (nos <= 0)
          stop(sprintf("Invalid number of states in %s.", filename))
        offset <- 2
      }
    }   # end of automatic format detection
    
    mat <- mat.or.vec(nos, noi)
    for (i in 1:nos) {
      mat[i,]<- 1L*as.logical(as.integer(unlist(strsplit(trimws(f[i+offset],which="both"),""))))
    }
    storage.mode(mat) <- "integer"
    if (as.letters) {
      names <- make.unique(letters[(0L:(ncol(mat)-1)) %% 26 + 1])
    } else {
      names <- as.integer(1L:ncol(mat))
    }
    colnames(mat) <- names
  }
  if (spreadsheet) {
    noi <- ncol(df)
    mat <- as.matrix(df, ncol=noi, nrow=nrow(df), byrow=FALSE)
    storage.mode(mat) <- "integer"
    rownames(mat) <- NULL
    if (is.null(colnames(mat))) {
      if (as.letters) {
        colnames(mat) <- make.unique(letters[(0L:(ncol(mat)-1)) %% 26 + 1])
      } else {
        colnames(mat) <- as.integer(1L:ncol(mat))
      }
    }
  }
  if (enforce) mat <- kmfamset(mat)
  s <- as.famset(mat)
  class(s) <- unique( c("kfamset", class(s)) )
  class(mat) <- unique(c("kmfamset", class(mat)))
  
  list(matrix = mat, sets = s)
}