ourMELONS/R/matlab2r.R

#' @title Convert Matlab function to R
#' @description Performs basic syntax conversion from Matlab to R
#' @param filename name of the file
#' @param output can be "asis", "clean", "save" or "diff"
#' @param improve_formatting if `TRUE` (default), makes minor changes
#' to conform to best-practice formatting conventions
#' @param change_assignment if `TRUE` (default), uses `<-` as the assignment operator
#' @param append if `FALSE` (default), overwrites file; otherwise, append
#' output to input
#' @return text converted to R, printed to screen or replacing input file
#' @author Waldir Leoncio
#' @importFrom utils write.table
#' @export
#' @note This function is intended to expedite the process of converting a
#' Matlab function to R by making common replacements. It does not have the
#' immediate goal of outputting a ready-to-use function. In other words,
#' after using this function you should go back to it and make minor changes.
#'
#' It is also advised to do a dry-run with `output = "clean"` and only switching
#' to `output = "save"` when you are confident that no important code will be
#' lost (for shorter functions, a careful visual inspection should suffice).
matlab2r <- function(filename, output = "diff", improve_formatting = TRUE, change_assignment = TRUE,
                     append = FALSE) {
  # TODO: this function is too long! Split into subfunctions
  # (say, by rule and/or section)
  # ======================================================== #
  # Verification                                             #
  # ======================================================== #
  if (!file.exists(filename)) stop("File not found")

  # ======================================================== #
  # Reading file into R                                      #
  # ======================================================== #
  txt <- readLines(filename)
  original <- txt

  # ======================================================== #
  # Replacing text                                           #
  # ======================================================== #

  # Uncommenting ------------------------------------------- #
  txt <- gsub("^#\\s?(.+)", "\\1", txt)

  # Output variable ---------------------------------------- #
  out <- gsub(
    pattern     = "\\t*function ((\\S|\\,\\s)+)\\s?=\\s?(\\w+)\\((.+)\\)",
    replacement = "\\1",
    x           = txt[1]
  ) # TODO: improve by detecting listed outputs
  if (substring(out, 1, 1) == "[") {
    out <- strsplit(out, "(\\,|\\[|\\]|\\s)")[[1]]
    out <- out[which(out != "")]
    out <- sapply(seq_along(out), function(x) paste(out[x], "=", out[x]))
    out <- paste0("list(", paste(out, collapse = ", "), ")")
  }

  # Function header ---------------------------------------- #
  txt <- gsub(
    pattern     = "\\t*function (.+)\\s*=\\s*(.+)\\((.+)\\)",
    replacement = "\\2 <- function(\\3) {",
    x           = txt
  )
  txt <- gsub(
    pattern     = "function (.+)\\((.+)\\)",
    replacement = "\\1 <- function(\\2) {",
    x           = txt
  )

  # Function body ------------------------------------------ #
  txt <- gsub("(.+)\\.\\.\\.", "\\1", txt)
  txt <- gsub(";", "", txt)

  # Loops and if-statements
  txt <- gsub("for (.+)=(.+)", "for (\\1 in \\2) {", txt)
  txt <- gsub("end$", "}", txt)
  txt <- gsub("if (.+)", "if (\\1) {", txt) # FIXME: paste comments after {
  txt <- gsub("else$", "} else {", txt)
  txt <- gsub("elseif", "} else if", txt)
  txt <- gsub("while (.+)", "while \\1 {", txt)

  # MATLAB-equivalent functions in R
  txt <- gsub("gamma_ln", "log_gamma", txt)
  txt <- gsub("nchoosek", "choose", txt)
  txt <- gsub("isempty", "is.null", txt)
  # txt <- gsub("(.+)\\'", "t(\\1)", txt)

  # Subsets ------------------------------------------------ #
  ass_op <- ifelse(change_assignment, "<-", "=")
  txt <- gsub(
    pattern = "([^\\(]+)\\(([^\\(]+)\\)=(.+)",
    replacement = paste0("\\1[\\2] ", ass_op, "\\3"),
    x = txt
  )
  txt <- gsub("\\(:\\)", "[, ]", txt)
  txt <- gsub("(.+)(\\[|\\():,end(\\]|\\()", "\\1[, ncol()]", txt)

  # Formatting --------------------------------------------- #
  if (improve_formatting) {
    txt <- gsub("(.),(\\S)", "\\1, \\2", txt)
    # Math operators
    txt <- gsub("(\\S)\\+(\\S)", "\\1 + \\2", txt)
    txt <- gsub("(\\S)\\-(\\S)", "\\1 - \\2", txt)
    txt <- gsub("(\\S)\\*(\\S)", "\\1 * \\2", txt)
    txt <- gsub("(\\S)\\/(\\S)", "\\1 / \\2", txt)
    # Logic operators
    txt <- gsub("~", "!", txt)
    txt <- gsub("(\\S)>=(\\S)", "\\1 >= \\2", txt)
    txt <- gsub("(\\S)<=(\\S)", "\\1 <= \\2", txt)
    txt <- gsub("(\\S)==(\\S)", "\\1 == \\2", txt)
    # Assignment
    txt <- gsub(
      pattern = "(\\w)(\\s?)=(\\s?)(\\w)",
      replacement = paste0("\\1 ", ass_op, " \\4"),
      x = txt
    )
    # txt <- gsub(
    # 	pattern = "(\\s+(.|\\_|\\[|\\])+)(\\s?)=(\\s?)(.+)",
    # 	replacement = paste0("\\1 ", ass_op, "\\5"),
    # 	x = txt
    # )
    txt <- gsub("%(\\s?)(\\w)", "# \\2", txt)
  }

  # Adding output and end-of-file brace -------------------- #
  txt <- append(txt, paste0("\treturn(", out, ")\n}"))

  # Returning converted code ------------------------------- #
  if (output == "asis") {
    return(txt)
  } else if (output == "clean") {
    return(cat(txt, sep = "\n"))
  } else if (output == "save") {
    return(
      write.table(
        x         = txt,
        file      = filename,
        quote     = FALSE,
        row.names = FALSE,
        col.names = FALSE,
        append    = append
      )
    )
  } else if (output == "diff") {
    diff_text <- vector(mode = "character", length = (2 * length(original) + 1))
    for (i in seq_along(txt)) {
      new_i <- (2 * i) + i - 2
      diff_text[new_i] <- paste(
        "-----------------------", "line", i, "-----------------------"
      )
      diff_text[new_i + 1] <- original[i]
      diff_text[new_i + 2] <- txt[i]
    }
    message("Displaying line number, original content and modified content")
    return(cat(diff_text, sep = "\n"))
  } else {
    stop("Invalid output argument")
  }
}