Output

#' Write a surmise function to file
#' 
#' @param x Surmise relation (\code{kmsurmiserelation} object)
#' @param filename Name of the file to be written
#' @param format File format
#' @param sep Cell separator for CSV files
#' 
#' Surmise relations are available only in matrix format. 
#' 
#' If \code{format} is \code{NULL}, SRBT is selected, If the filename has a
#' spreadsheet file type extension, the respective type is selected.#
#' 
#' @family Functions for reading and writing surmise and attribution functions and relations
#' 
#' @importFrom tools file_ext
#' @importFrom utils write.table 
#' @importFrom readODS write_ods
#' @importFrom openxlsx2 write_xlsx
#' 
#' @export 
write_surmiserelation <- function (x, filename, format=NULL, sep=',') {
  
  if (!inherits(x, "kmsurmiserelation")) 
    stop(sprintf("%s must be of class %s!",
                 dQuote("x"),
                 dQuote("kmsurmiserelation")
    ))
  mat <- x
  ext <- tolower(file_ext(filename))
  if (is.null(format)) {
    if (ext == "csv") format <- "CSV"
    else if (ext == "xlsx") format <- "XLSX"
    else if (ext == "ods") format <- "ODS"
    else format <- "SRBT"
  } else {
    if ((ext == "csv") && (format != "CSV"))
      warning(sprintf('Storing file in "%s" format in .csv file!', format))
    else if ((ext == "ods") && (format != "ODS"))
      warning(sprintf('Storing file in "%s" format in .ods file!', format))
    else if ((ext == "xlsx") && (format != "XLSX"))
      warning(sprintf('Storing file in "%s" format in .xlsx file!', format))
    else if (format %in% c("CSV", "ODS", "XLSX") && tolower(format) != ext)
      warning(sprintf("Format specification '%s' and filename extension '%s' do nto fit together!",
                      format, ext))
  }
  
  if (format == "CSV") {
    if (sep == ',') dec <- '.'
    else dec <- ','
    if (is.null(colnames(mat)))
      write.table(mat, filename, sep=sep, row.names=FALSE, col.names=FALSE)
    else
      write.table(mat, filename, sep=sep, row.names=FALSE, col.names=TRUE)
  } else if (format == "XLSX") {
    if (is.null(colnames(mat)))
      write_xlsx(as.data.frame(mat), file = filename, col.names=FALSE)
    else write_xlsx(as.data.frame(mat), file = filename)
  } else if (format == "ODS") {
    if (is.null(colnames(mat)))
      write_ods(as.data.frame(mat), path = filename, col_names=FALSE)
    else write_ods(as.data.frame(mat), path = filename)
  } else {
    con <- file(filename)
    if (is.null(con))
      stop(sprintf("Unable to open file %s.", dQuote(filename)))
    open(con, open="w")
    
    size <- dim(mat)
    
    if (format == "SRBT") {
      cat("#SRBT v2.0 relation\n", file=con)
      cat(sprintf("%d\n", size[1]), file=con)
    } else if (format != "matrix") {
      stop(sprintf("%s must be either %s or %s!",
                   dQuote("format"),
                   dQuote("SRBT"),
                   dQuote("matrix")))
    }
    
    colnames(mat) <- NULL
    write.table(mat, sep="", file=con, col.names=FALSE, row.names=FALSE)
    
    close(con)
  }
}




#' Write an attribution function to file
#' 
#' @param x Attribution relation (\code{kmattributionrelation} object)
#' @param filename Name of the file to be written
#' @param format File format
#' @param sep Cell separator for CSV files
#' 
#' Attribution relations are available only in matrix format. 
#' 
#' If \code{format} is \code{NULL}, SRBT is selected, If the filename has a
#' spreadsheet file type extension, the respective type is selected.#
#' 
#' @examples
#' kstMatrix::xpl$sr
#' tempfile <- paste0(tempdir(), "/test_sf.csv")
#' write_surmiserelation(kstMatrix::xpl$sr, tempfile)
#' cat(readLines(tempfile), sep='\n')
#' 
#' @family Functions for reading and writing surmise and attribution functions and relations
#' @rdname write_surmiserelation
#' 
#' @importFrom tools file_ext
#' @importFrom utils write.table 
#' @importFrom readODS write_ods
#' @importFrom openxlsx2 write_xlsx
#' 
#' @export 
write_attributionrelation <- function (x, filename, format=NULL, sep=',') {
  
  if (!inherits(x, "kmsurmiserelation")) 
    stop(sprintf("%s must be of class %s!",
                 dQuote("x"),
                 dQuote("kmsurmiserelation")
    ))
  else {
    mat <- x
    if (dim(mat)[1] != dim(mat)[2]) {
      stop(sprintf("%s must be a quadratic matrix!",
                   dQuote("x")))
    }
  }
  ext <- tolower(file_ext(filename))
  if (is.null(format)) {
    if (ext == "csv") format <- "CSV"
    else if (ext == "xlsx") format <- "XLSX"
    else if (ext == "ods") format <- "ODS"
    else format <- "SRBT"
  } else {
    if ((ext == "csv") && (format != "CSV"))
      warning(sprintf('Storing file in "%s" format in .csv file!', format))
    else if ((ext == "ods") && (format != "ODS"))
      warning(sprintf('Storing file in "%s" format in .ods file!', format))
    else if ((ext == "xlsx") && (format != "XLSX"))
      warning(sprintf('Storing file in "%s" format in .xlsx file!', format))
    else if (format %in% c("CSV", "ODS", "XLSX") && tolower(format) != ext)
      warning(sprintf("Format specification '%s' and filename extension '%s' do nto fit together!",
                      format, ext))
  }
  
  if (format == "CSV") {
    if (sep == ',') dec <- '.'
    else dec <- ','
    if (is.null(colnames(mat)))
      write.table(mat, filename, sep=sep, row.names=FALSE, col.names=FALSE)
    else
      write.table(mat, filename, sep=sep, row.names=FALSE, col.names=TRUE)
  } else if (format == "XLSX") {
    if (is.null(colnames(mat)))
      write_xlsx(as.data.frame(mat), file = filename, col.names=FALSE)
    else write_xlsx(as.data.frame(mat), file = filename)
  } else if (format == "ODS") {
    if (is.null(colnames(mat)))
      write_ods(as.data.frame(mat), path = filename, col_names=FALSE)
    else write_ods(as.data.frame(mat), path = filename)
  } else {
    con <- file(filename)
    if (is.null(con))
      stop(sprintf("Unable to open file %s.", dQuote(filename)))
    open(con, open="w")
    
    size <- dim(mat)
    
    if (format == "SRBT") {
      cat("#SRBT v2.0 relation\n", file=con)
      cat(sprintf("%d\n", size[1]), file=con)
    } else if (format != "matrix") {
      stop(sprintf("%s must be either %s or %s!",
                   dQuote("format"),
                   dQuote("SRBT"),
                   dQuote("matrix")))
    }
    
    colnames(mat) <- NULL
    write.table(mat, sep="", file=con, col.names=FALSE, row.names=FALSE)
    
    close(con)
  }
}