//   R : A Computer Language for Statistical Data Analysis
//   Copyright (C) 2000, 2002  the R Development Core Team

//   This program is free software; you can redistribute it and/or modify
//   it under the terms of the GNU General Public License as published by
//   the Free Software Foundation; either version 2 of the License, or
//   (at your option) any later version.

//   This program is distributed in the hope that it will be useful,
//   but WITHOUT ANY WARRANTY; without even the implied warranty of
//   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//   GNU General Public License for more details.

//   You should have received a copy of the GNU General Public License
//   along with this program; if not, write to the Free Software
//   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#include "orthonormal.h"

SEXP LaColOrthogonalMatDouble::asSEXP() const
{
    if (size(0) < 1 || size(1) < 1) return R_NilValue;

    SEXP val = PROTECT(allocMatrix(REALSXP, size(0), size(1)));
    F77_CALL(dlacpy)('A', size(0), size(1), this->addr(), gdim(0),
                     REAL(val), size(0));
    SEXP classes = PROTECT(allocVector(STRSXP, 2));
    SET_STRING_ELT(classes, 0, mkChar("ColOrthogonal"));
    SET_STRING_ELT(classes, 1, mkChar("Matrix"));
    setAttrib(val, R_ClassSymbol, classes);
    UNPROTECT(2);
    return val;
}

SEXP LaRowOrthogonalMatDouble::asSEXP() const
{
    if (size(0) < 1 || size(1) < 1) return R_NilValue;

    SEXP val = PROTECT(allocMatrix(REALSXP, size(0), size(1)));
    F77_CALL(dlacpy)('A', size(0), size(1), this->addr(), gdim(0),
                     REAL(val), size(0));
    SEXP classes = PROTECT(allocVector(STRSXP, 2));
    SET_STRING_ELT(classes, 0, mkChar("RowOrthogonal"));
    SET_STRING_ELT(classes, 1, mkChar("Matrix"));
    setAttrib(val, R_ClassSymbol, classes);
    UNPROTECT(2);
    return val;
}

SEXP LaColOrthonormalMatDouble::asSEXP() const
{
    if (size(0) < 1 || size(1) < 1) return R_NilValue;

    SEXP val = PROTECT(allocMatrix(REALSXP, size(0), size(1)));
    F77_CALL(dlacpy)('A', size(0), size(1), this->addr(), gdim(0),
                     REAL(val), size(0));
    SEXP classes = PROTECT(allocVector(STRSXP, 3));
    SET_STRING_ELT(classes, 0, mkChar("ColOrthonormal"));
    SET_STRING_ELT(classes, 1, mkChar("ColOrthogonal"));
    SET_STRING_ELT(classes, 2, mkChar("Matrix"));
    setAttrib(val, R_ClassSymbol, classes);
    UNPROTECT(2);
    return val;
}

SEXP LaRowOrthonormalMatDouble::asSEXP() const
{
    if (size(0) < 1 || size(1) < 1) return R_NilValue;

    SEXP val = PROTECT(allocMatrix(REALSXP, size(0), size(1)));
    F77_CALL(dlacpy)('A', size(0), size(1), this->addr(), gdim(0),
                     REAL(val), size(0));
    SEXP classes = PROTECT(allocVector(STRSXP, 3));
    SET_STRING_ELT(classes, 0, mkChar("RowOrthonormal"));
    SET_STRING_ELT(classes, 1, mkChar("RowOrthogonal"));
    SET_STRING_ELT(classes, 2, mkChar("Matrix"));
    setAttrib(val, R_ClassSymbol, classes);
    UNPROTECT(2);
    return val;
}

SEXP LaOrthogonalMatDouble::asSEXP() const
{
    int m = LaGenMatDouble::size(0), n = LaGenMatDouble::size(1),
	lda = LaGenMatDouble::gdim(0);

    if (m < 1 || n < 1) return R_NilValue;

    SEXP val = PROTECT(allocMatrix(REALSXP, m, n));
    F77_CALL(dlacpy)('A', m, n, this->addr(), lda, REAL(val), m);
    SEXP classes = PROTECT(allocVector(STRSXP, 6));
    SET_STRING_ELT(classes, 0, mkChar("Orthogonal"));
    SET_STRING_ELT(classes, 1, mkChar("RowOrthonormal"));
    SET_STRING_ELT(classes, 2, mkChar("RowOrthogonal"));
    SET_STRING_ELT(classes, 3, mkChar("ColOrthonormal"));
    SET_STRING_ELT(classes, 4, mkChar("ColOrthogonal"));
    SET_STRING_ELT(classes, 5, mkChar("Matrix"));
    setAttrib(val, R_ClassSymbol, classes);
    UNPROTECT(2);
    return val;
}