R/FLTrace.R

#' @include FLMatrix.R
NULL

#' Matrix Trace.
#'
#' \code{tr} computes the trace of FLMatrix objects.
#'
#' \code{tr} computes the trace of input FLMatrix object, stores the result
#' in-database and returns R vector object
#' @param object an object of class FLMatrix
#' @param ... any additional arguments
#' @return \code{tr} returns R Vector object of size 1 which replicates the equivalent R output.
#' @section Constraints:
#' Input matrix can only be square matrix with maximum dimension limitations
#' of (1000 x 1000).
#' @examples
#' flmatrix <- FLMatrix(getTestTableName("tblMatrixMulti"), 5,"MATRIX_ID","ROW_ID",
#'                       "COL_ID","CELL_VAL",dims= c(5,5))
#' resultFLVector <- tr(flmatrix)
#' @seealso \code{\link[psych]{tr}} for corresponding R function reference
#' @export
tr<-function(object, ...){
	UseMethod("tr", object)
}

#' @export
tr.default <- function(object,...){
    if (!requireNamespace("psych", quietly = TRUE)){
            stop("psych package needed for tr. Please install it.",
            call. = FALSE)
            }
    else return(psych::tr(object,...))
}

#' @export
tr.FLMatrix<-function(object,...){
	connection<-getFLConnection(object)
	
	## flag3Check(connection)

	sqlstr<-paste0( " SELECT 
					  FLMatrixTrace(",getVariables(object)$rowId,
			         			   ",",getVariables(object)$colId,
			              		   ",",getVariables(object)$value,")",
				    " FROM ",tableAndAlias(object),
				    constructWhere(c(constraintsSQL(object),
				    	paste0(getVariables(object)$rowId," <= ",min(nrow(object),ncol(object))),
				    	paste0(getVariables(object)$colId, " <= ", min(nrow(object),ncol(object))))))

	sqlstr <- gsub("'%insertIDhere%'",1,sqlstr)
	sqlstr <- ensureQuerySize(pResult=sqlstr,
            pInput=list(object),
            pOperator="tr")
	return(sqlQuery(connection,sqlstr)[1,1])
}

#' @export
tr.FLMatrix.Hadoop <- function(object,...){
    connection<-getFLConnection(object)
    
    ## flag3Check(connection)

    # sqlstr<-paste0( " SELECT 
    #                   FLMatrixTrace(",getVariables(object)$rowId,
    #                                ",",getVariables(object)$colId,
    #                                ",",getVariables(object)$value,")",
    #                 " FROM ",tableAndAlias(object),
    #                 constructWhere(c(constraintsSQL(object),
    #                     paste0(getVariables(object)$rowId," <= ",min(nrow(object),ncol(object))),
    #                     paste0(getVariables(object)$colId, " <= ", min(nrow(object),ncol(object))))))
    
    sqlstr <- constructMatrixUDTSQL(pObject=object,
                                    pFuncName="FLMatrixTrace",
                                    pdims=getDimsSlot(object),
                                    pdimnames=dimnames(object),
                                    pReturnQuery=TRUE
                                    )
    sqlstr <- gsub("'%insertIDhere%'",1,sqlstr)
    sqlstr <- ensureQuerySize(pResult=sqlstr,
                              pInput=list(object),
                              pOperator="tr")
    return(sqlQuery(connection,sqlstr)[["trace_value"]])
}
Fuzzy-Logix/AdapteR documentation built on May 6, 2019, 5:07 p.m.