R/read_kfamset.R

Defines functions read_kfamset

Documented in read_kfamset

### kfamset.R
###
### dependencies: kst, stringr, openxlsx, openODS, tools
###

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)
    else {
      df <- read_ods(filename, col_names=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)
}

Try the kstIO package in your browser

Any scripts or data that you put into this service are public.

kstIO documentation built on March 8, 2026, 5:06 p.m.