.packageName <- "matlab"
#
# CEIL.R - Rounds to the nearest integer
#


##-----------------------------------------------------------------------------
ceil <- function(x)
    ceiling(x)

#
# EYE.R - Create an identity matrix
#


##-----------------------------------------------------------------------------
eye <- function(n, m = n) {
    if (!(is.numeric(n) && (n > 0))) {
        stop(paste("argument", sQuote("n"), "must be natural number"))
    }

    if (!(is.numeric(m) && (m > 0))) {
        stop(paste("argument", sQuote("m"), "must be natural number"))
    }

    # Handle special case of size argument
    if (matlab:::is.size_t(n) == TRUE) {
        m <- 1
    }

    return(diag(1, n, m))
}

#
# FIND.R - Find indices of nonzero elements
#


##-----------------------------------------------------------------------------
find <- function(x) {
    expr <- if (is.logical(x)) {
                x
            } else {
                x != 0
            }
    which(expr)
}

#
# FIX.R - Round toward zero.
#


##-----------------------------------------------------------------------------
fix <- function(A)
    trunc(A)

#
# FLIPLR.R - Flip matrices left-right
#

library(methods)


##-----------------------------------------------------------------------------
setGeneric("fliplr",
           function(object) {
               #cat("generic", match.call()[[1]], "\n")
               standardGeneric("fliplr")
           })

setMethod("fliplr",
          signature(object = "vector"),
          function(object) {
              #cat(match.call()[[1]], "(vector)", "\n")
              return(rev(object))
           })

setMethod("fliplr",
          signature(object = "matrix"),
          function(object) {
              #cat(match.call()[[1]], "(matrix)", "\n")
              n <- matlab::size(object)[2]
              return(object[,n:1])
           })

setMethod("fliplr",
          signature(object = "array"),
          function(object) {
              #cat(match.call()[[1]], "(array)", "\n")
              stop(paste("argument", sQuote("object"), "must be a vector or matrix"))
           })

setMethod("fliplr",
          signature(object = "ANY"),
          function(object) {
              #cat(match.call()[[1]], "(ANY)", "\n")
              stop(paste("method not defined for", data.class(object), "argument"))
           })

setMethod("fliplr",
          signature(object = "missing"),
          function(object) {
              #cat(match.call()[[1]], "(missing)", "\n")
              stop(paste("argument", sQuote("object"), "missing"))
           })

#
# FLIPUD.R - Flip matrices up-down
#

library(methods)


##-----------------------------------------------------------------------------
setGeneric("flipud",
           function(object) {
               #cat("generic", match.call()[[1]], "\n")
               standardGeneric("flipud")
}           )

setMethod("flipud",
          signature(object = "vector"),
          function(object) {
              #cat(match.call()[[1]], "(vector)", "\n")
              return(rev(object))
          })

setMethod("flipud",
          signature(object = "matrix"),
          function(object) {
              #cat(match.call()[[1]], "(matrix)", "\n")
              m <- matlab::size(object)[1]
              return(object[m:1,])
          })

setMethod("flipud",
          signature(object = "array"),
          function(object) {
              #cat(match.call()[[1]], "(array)", "\n")
              stop(paste("argument", sQuote("object"), "must be a vector or matrix"))
          })

setMethod("flipud",
          signature(object = "ANY"),
          function(object) {
              #cat(match.call()[[1]], "(ANY)", "\n")
              stop(paste("method not defined for", data.class(object), "argument"))
          })

setMethod("flipud",
          signature(object = "missing"),
          function(object) {
              #cat(match.call()[[1]], "(missing)", "\n")
              stop(paste("argument", sQuote("object"), "missing"))
          })

#
# LINSPACE.R - Generate linearly spaced vectors
#


##-----------------------------------------------------------------------------
linspace <- function(a, b, n = 100) {
    if (n < 2) {
        b
    } else {
        seq(a, b, length = n)
    }
}


#
# LOGSPACE.R - Generate logarithmically spaced vectors
#


##-----------------------------------------------------------------------------
logspace <- function(a, b, n = 50) {
    if (!(is.numeric(a) && length(a) == 1)) {
        stop(paste("argument", sQuote("a"), "must be a scalar"))
    }
    if (!(is.numeric(b) && length(b) == 1)) {
        stop(paste("argument", sQuote("b"), "must be a scalar"))
    }
    if (!(is.numeric(n) && length(n) == 1)) {
        stop(paste("argument", sQuote("n"), "must be a scalar"))
    }
    if (b == pi) {
        b <- log10(pi)
    }
    return(10 ^ seq(a, b, length = n))
}

#
# MOD.R - Modulus after division
#


##-----------------------------------------------------------------------------
mod <- function(x, y)
    x %% y

#
# ONES.R - Create a matrix of all ones
#


##-----------------------------------------------------------------------------
ones <- function(n, m = n) {
    if (!(is.numeric(n) && (n > 0))) {
        stop(paste("argument", sQuote("n"), "must be natural number"))
    }

    if (!(is.numeric(m) && (m > 0))) {
        stop(paste("argument", sQuote("m"), "must be natural number"))
    }

    # Handle special case of size argument
    if (matlab:::is.size_t(n) == TRUE) {
        m <- 1
    }

    .fillMatrix <- function(n, m = n, x = 1) {
        nm <- rep.int(x, (n*m))
        return(matrix(nm, n, m))
    }

    return(.fillMatrix(n, m))
}

#
# PASCAL.R - Create Pascal matrix
#


##-----------------------------------------------------------------------------
pascal <- function(n, k = 0) {
    if (!(is.numeric(n) && length(n) == 1)) {
        stop(paste("argument", sQuote("n"), "must be scalar"))
    }
    if (!(is.numeric(k) && length(k) == 1)) {
        stop(paste("argument", sQuote("k"), "must be scalar"))
    }
    stopifnot(k >= 0, k <= 2)

    P <- diag((-1) ^ seq(0, as.double(n)-1))
    P[,1] <- matlab::ones(n, 1)

    # Generate Pascal Cholesky factor
    for (j in seq(2, n-1)) {
        for (i in seq(j+1, n)) {
            P[i, j] <- P[i-1, j] - P[i-1, j-1]
        }
    }

    if (k == 0) {
        P<- P %*% t(P)
    } else if ( k == 1) {
        ;
    } else if (k == 2) {
        P <- matlab::rot90(P, 3)
        if ((n / 2) == round(n / 2)) {
            P <- -P
        }
    }
    return(P)
}

#
# REM.R - Remainder after division
#


##-----------------------------------------------------------------------------
rem <- function(x, y) {
    ans <- matlab::mod(x, y)
    if (!((x > 0 && y > 0) ||
          (x < 0 && y < 0))) {
        ans <- ans - y
    }
    return(ans)
}

#
# REPMAT.R - Replicate and tile an array
#


##-----------------------------------------------------------------------------
repmat <- function(A, m, n = if (length(m) == 1)m) {
    m <- c(m, n)
    stopifnot(length(m) == 2)
    kronecker(matrix(1, m[1], m[2]), A)
}

#
# ROT90.R - Rotates matrix counterclockwise k*90 degrees
#


##-----------------------------------------------------------------------------
rot90 <- function(A, k = 1) {
    if (!(is.matrix(A))) {
        stop(paste("argument", sQuote("A"), "must be a 2-D matrix"))
    }

    if (!(length(k) == 1)) {
        stop(paste("argument", sQuote("k"), "must be a scalar"))
    }

    .rot90 <- function(A) {
        n <- matlab::size(A)[2]

        A <- t(A)
        return(A[n:1,])
    }

    .rot180 <- function(A) {
        sz <- matlab::size(A)
        m <- sz[1]
        n <- sz[2]

        return(A[m:1, n:1])
    }

    .rot270 <- function(A) {
        m <- matlab::size(A)[1]

        return(t(A[m:1,]))
    }

    k <- matlab::rem(k,4)
    if (k <= 0) {
        k <- k + 4
    }

    return(switch(k,
                  .rot90(A),
                  .rot180(A),
                  .rot270(A),
                  A))
}

#
# SIZE.R - Array dimensions
#

library(methods)


##-----------------------------------------------------------------------------
setGeneric("size",
           function(X, dimen) {
               #cat("generic", match.call()[[1]], "\n")
               standardGeneric("size")
           })

setMethod("size",
          signature(X = "vector", dimen = "missing"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(vector, missing)", "\n")
              return(as.size_t(length(X)))
          })

setMethod("size",
          signature(X = "matrix", dimen = "missing"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(matrix, missing)", "\n")
              return(as.size_t(dim(X)))
          })

setMethod("size",
          signature(X = "array", dimen = "missing"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(array, missing)", "\n")
              return(as.size_t(dim(X)))
          })

setMethod("size",
          signature(X = "matrix", dimen = "numeric"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(matrix, numeric)", "\n")
              callGeneric(X, as.integer(dimen))
          })

setMethod("size",
          signature(X = "matrix", dimen = "integer"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(matrix, integer)", "\n")
              return(as.size_t(getLengthOfDimension(X, dimen)))
          })

setMethod("size",
          signature(X = "array", dimen = "numeric"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(array, numeric)", "\n")
              callGeneric(X, as.integer(dimen))
          })

setMethod("size",
          signature(X = "array", dimen = "integer"),
          function(X, dimen) {
              #cat(match.call()[[1]],
              #    "(", data.class(X), ", ", data.class(dimen), ")", "\n")
              return(as.size_t(getLengthOfDimension(X, dimen)))
          })

setMethod("size",
          signature(X = "missing"),
          function(X, dimen) {
              #cat(match.call()[[1]], "(missing)", "\n")
              stop(paste("argument", sQuote("X"), "missing"))
          })

getLengthOfDimension <- function(X, dimen) {
    if (is.array(X) == FALSE) {
        stop(paste("argument", sQuote("X"), "must be matrix or array"))
    }

    if (length(dimen) > 1) {
        stop(paste("argument", sQuote("dimen"), "must be scalar"))
    }

    if (dimen < 1) {
        stop(paste("argument", sQuote("dimen"), "must be positive value"))
    }

    len <- if (dimen <= length(dim(X))) {
               dim(X)[dimen]
           } else {
               1	# singleton dimension
           }

    return(as.size_t(len))
}

#
# SIZE_T.R - Size class
#

library(methods)


##-----------------------------------------------------------------------------
setClass("size_t",
         contains = "integer",
         prototype = as.integer(0))


##-----------------------------------------------------------------------------
size_t <- function(x) {
    return(new("size_t", as.integer(x)))
}


##-----------------------------------------------------------------------------
is.size_t <- function(x) {
    return(data.class(x) == "size_t")
}


##-----------------------------------------------------------------------------
as.size_t <- function(x) {
    return(size_t(x))
}

#
# STD.R - Standard deviation
#


##-----------------------------------------------------------------------------
std <- function(x, flag = 0) {
    if (flag != 0) {
        stop("biased standard deviation not implemented")
    }
    sd(x)
}

#
# SUM.R - Sum of elements
#

library(methods)


##-----------------------------------------------------------------------------
setGeneric("sum",
           function(x, na.rm = FALSE) {
               #cat("generic", match.call()[[1]], "\n")
               if (!is.logical(na.rm)) {
                   stop(paste("argument", sQuote("na.rm"), "must be logical"))
               }
               standardGeneric("sum")
           },
           useAsDefault = FALSE)

setMethod("sum",
          signature(x = "vector", na.rm = "logical"),
          function(x, na.rm) {
              #cat(match.call()[[1]], "(vector, logical)", "\n")
              #cat("\tx = ", x, "\n")
              #cat("\tna.rm = ", na.rm, "\n")
              return(base::sum(x, na.rm = na.rm))
          })

setMethod("sum",
          signature(x = "vector", na.rm = "missing"),
          function(x, na.rm) {
              #cat(match.call()[[1]], "(vector, missing)", "\n")
              callGeneric(x, na.rm)
          })

setMethod("sum",
          signature(x = "matrix", na.rm = "logical"),
          function(x, na.rm) {
              #cat(match.call()[[1]], "(matrix, logical)", "\n")
              #cat("\tx =\n"); print(x); cat("\n")
              #cat("\tna.rm = ", na.rm, "\n")
              return(apply(x, 2, base::sum, na.rm = na.rm))
          })

setMethod("sum",
          signature(x = "matrix", na.rm = "missing"),
          function(x, na.rm) {
              #cat(match.call()[[1]], "(matrix, missing)", "\n")
              callGeneric(x, na.rm)
          })

setMethod("sum",
          signature(x = "array", na.rm = "logical"),
          function(x, na.rm) {
              stop(paste("method not implemented for", data.class(x), "argument"))
          })

setMethod("sum",
          signature(x = "array", na.rm = "missing"),
          function(x, na.rm) {
              #cat(match.call()[[1]], "(array, missing)", "\n")
              callGeneric(x, na.rm)
          })

setMethod("sum",
          signature(x = "logical"),
          function(x, na.rm) {
              stop(paste("argument", sQuote("x"), "cannot be logical"))
          })

setMethod("sum",
          signature(x = "ANY"),
          function(x, na.rm) {
              #cat(match.call()[[1]], "(ANY)", "\n")
              stop(paste("method not defined for", data.class(x), "argument"))
          })

setMethod("sum",
          signature(x = "missing"),
          function(x, na.rm) {
              stop(paste("argument", sQuote("x"), "missing"))
          })

#
# TICTOC.R - Stopwatch Timer
#


##-----------------------------------------------------------------------------
tic <- function(gcFirst = FALSE) {
    if (gcFirst == TRUE) {
        gc(verbose = FALSE)
    }
    assign("savedTime", proc.time()[3], envir = .MatlabNamespaceEnv)
    invisible()
}


##-----------------------------------------------------------------------------
toc <- function(echo = TRUE) {
    prevTime <- get("savedTime", envir = .MatlabNamespaceEnv)
    diffTimeSecs <- proc.time()[3] - prevTime
    if (echo) {
        cat("elapsed time is", diffTimeSecs, "seconds", "\n")
        return(invisible())
    } else {
        return(diffTimeSecs)
    }
}

#
# ZEROS.R - Create a matrix of all zeros
#


##-----------------------------------------------------------------------------
zeros <- function(n, m = n) {
    if (!(is.numeric(n) && (n > 0))) {
        stop(paste("argument", sQuote("n"), "must be natural number"))
    }

    if (!(is.numeric(m) && (m > 0))) {
        stop(paste("argument", sQuote("m"), "must be natural number"))
    }

    # Handle special case of size argument
    if (matlab:::is.size_t(n) == TRUE) {
        m <- 1
    }

    .fillMatrix <- function(n, m = n, x = 0) {
        nm <- rep.int(x, (n*m))
        return(matrix(nm, n, m))
    }

    return(.fillMatrix(n, m))
}

#
# ZZZ.R
#


# Namespace environment for this package
.MatlabNamespaceEnv <- new.env()


##
## Package/Namespace Hooks
##

##-----------------------------------------------------------------------------
.onAttach <- function(libname, pkgname) {
    verbose <- getOption("verbose")
    if (verbose) {
        local({
            libraryPkgName <- function(pkgname, sep = "_") {
                unlist(strsplit(pkgname, sep, fixed = TRUE))[1]
            }
            packageDescription <- function(pkgname) {
                fieldnames <- c("Title", "Version")
                descfile <- file.path(libname, pkgname, "DESCRIPTION")
                desc <- as.list(read.dcf(descfile, fieldnames))
                names(desc) <- fieldnames
                return(desc)
            }

            desc <- packageDescription(pkgname)
            cat(paste(desc$Title, ", version ", desc$Version, sep = ""), "\n")
            cat(paste("Type library(help=",
                      sQuote(libraryPkgName(pkgname)),
                      ") to see package documentation.", sep = ""), "\n")
        })
    }
}


##-----------------------------------------------------------------------------
.onLoad <- function(libname, pkgname) {
    environment(.MatlabNamespaceEnv) <- asNamespace("matlab")

    # Load internal variables
    assign("savedTime", 0, envir = .MatlabNamespaceEnv)

    # Allow no changes or additions to environment
    lockEnvironment(.MatlabNamespaceEnv, bindings = TRUE)

    # Only allow internal vars to change
    unlockBinding("savedTime", .MatlabNamespaceEnv)
}

