.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('Argument "n" must be natural number');
    }

    if (!(is.numeric(m) && (m > 0))) {
        stop('Argument "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) {
    standardGeneric("fliplr")
})

setMethod("fliplr", signature(object = "vector"), function(object) {
    return(rev(object));
})

setMethod("fliplr", signature(object = "matrix"), function(object) {
    n <- matlab::size(object)[2];
    return(object[,n:1]);
})

setMethod("fliplr", signature(object = "array"), function(object) {
    stop('Argument "object" must either be a vector or matrix')
})

setMethod("fliplr", signature(object = "ANY"), function(object) {
    stop(paste('Method not defined for', data.class(object), 'argument'))
})

setMethod("fliplr", signature(object = "missing"), function(object) {
    stop('Argument "object" missing')
})

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

library(methods)


##-----------------------------------------------------------------------------
setGeneric("flipud", function(object) {
    standardGeneric("flipud")
})

setMethod("flipud", signature(object = "vector"), function(object) {
    return(rev(object));
})

setMethod("flipud", signature(object = "matrix"), function(object) {
    m <- matlab::size(object)[1];
    return(object[m:1,]);
})

setMethod("flipud", signature(object = "array"), function(object) {
    stop('Argument "object" must either be a vector or matrix')
})

setMethod("flipud", signature(object = "ANY"), function(object) {
    stop(paste('Method not defined for', data.class(object), 'argument'))
})

setMethod("flipud", signature(object = "missing"), function(object) {
    stop('Argument "object" missing')
})

#
# 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('Argument "n" must be natural number');
    }

    if (!(is.numeric(m) && (m > 0))) {
        stop('Argument "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));
}

#
# 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('Argument "A" must be a 2-D matrix.');
    }

    if (!(length(k) == 1)) {
        stop('Argument "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
#


##-----------------------------------------------------------------------------
size <- function(x) {
    if (is.vector(x)) {
        len <- length(x)
    } else if (is.matrix(x)) {
        len <- dim(x)
    } else {
        stop('Argument "x" must be vector or matrix')
    }

    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 sum\n");
    if (!is.logical(na.rm)) {
        stop('Argument "na.rm" must be logical')
    }
    standardGeneric("sum")
}, useAsDefault = FALSE)

setMethod("sum", signature(x = "vector", na.rm = "logical"), function(x, na.rm) {
    #cat("sum(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("sum(vector, missing)\n")
    callGeneric(x, na.rm);
})

setMethod("sum", signature(x = "matrix", na.rm = "logical"), function(x, na.rm) {
    #cat("sum(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("sum(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("sum(array, missing)\n")
    callGeneric(x, na.rm)
})

setMethod("sum", signature(x = "logical"), function(x, na.rm) {
    stop('Argument "x" cannot be logical')
})

setMethod("sum", signature(x = "ANY"), function(x, na.rm) {
    #cat("sum(ANY)\n")
    stop(paste('Method not defined for', data.class(x), 'argument'))
})

setMethod("sum", signature(x = "missing"), function(x, na.rm) {
    stop('Argument "x" missing')
})

#
# TICTOC.R - Stopwatch Timer
#


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


##-----------------------------------------------------------------------------
toc <- function() {
    prevTime <- get("savedTime", envir = .MatlabNamespaceEnv)
    diffTimeSecs <- proc.time()[3] - prevTime;
    cat('Elapsed time is', diffTimeSecs, 'seconds', '\n');
}

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


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

    if (!(is.numeric(m) && (m > 0))) {
        stop('Argument "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) {
        cat("Matlab support package attached.",
            "Type library(help='matlab') to see package documentation.",
            sep="\n");
    }
}


##-----------------------------------------------------------------------------
.onLoad <- function(libname, pkgname) {
    environment(.MatlabNamespaceEnv) <- asNamespace("matlab")
    assign("savedTime", 0, envir = .MatlabNamespaceEnv)
}

