R/FLCastFunctions.R

In Fuzzy-Logix/AdapteR: Converts R syntax to SQL to provide fast analytics using in-database C++ library DB Lytix.

#' @include FLMatrix.R
NULL

#' Converts FLMatrix object to vector in R
#' @export
as.vector.FLMatrix <- function(object,mode="any")
{
	temp_m <- as.matrix(object)
	return(as.vector(temp_m))
}

#' Converts FLSkalarAggregate object to vector in R
#' @export
as.vector.FLSkalarAggregate <- function(object,mode="any")
{
    do.call(mixedAggregate,append(llply(object@arguments,as.vector),
                                  list(Rfun=object@func,FLfun="")))
}

#' @export
as.vector.FLMatrixBind <- function(object,mode="any")
{
	temp_m <- as.matrix(object)
	return(as.vector(temp_m))
}

#' Converts FLVector object to vector in R
#' @export
as.vector.FLVector <- function(object,mode="any")
{
    vprev1 <- getOption("stringsAsFactors")
    vprev2 <- getOption("warn")
    options(stringsAsFactors=FALSE)
    options(warn=-1)
    if(ncol(object)==1)
        x <- as.data.frame.FLVector(object)[[1]]
    if(ncol(object)>1)
        x <- as.vector(as.matrix(as.data.frame.FLVector(object)[1,]))
    # if(!any(is.na(as.numeric(x))) && !is.logical(x))
    # x <- as.numeric(x)

    ## Adjust Return Type:
    vTypeMapping <- c(as.logical="logical",
                      as.character="character",
                      as.integer="integer")
    vfunc <- names(vTypeMapping)[vTypeMapping==typeof(object)]
    if(length(vfunc)>0)
        x <- do.call(vfunc,list(x))
    
    if(ncol(object)==1) vnames <- rownames(object)
    else vnames <- colnames(object)
    if(is.character(vnames) && !all(vnames==1:length(vnames)))
    names(x) <- vnames[1:length(x)]

    options(stringsAsFactors=vprev1)
    options(warn=vprev2)
    return(x)
}

#' Converts in-database objects to a data frame in R
#' 
#' Caution: data is fetched into R session
#' @param x can be FLTable, FLVector or FLMatrix
#' @param ... any additional arguments
#' @return R data.frame object
#' @export
as.data.frame <- function(x, ...)
{
	UseMethod("as.data.frame",x)
}

#' @export
as.data.frame.FLTable <- function(x, ...){
    sqlstr <- constructSelect(x)
    sqlstr <- gsub("'%insertIDhere%'",1,sqlstr)
    tryCatch(D <- sqlQuery(getFLConnection(x),sqlstr),
      error=function(e){stop(e)})
    vnames <- names(D)
    vobsidcol <- getIndexSQLName(x,margin=1)
    vnames <- vnames[-grepl(vobsidcol,vnames,ignore.case=TRUE)]
    names(D) <- toupper(names(D))
    D <- plyr::arrange(D,D[[toupper(vobsidcol)]])
    ##browser()
    if(isDeep(x)) {
        vvaridcol <- getIndexSQLName(x,margin=2)
        vvaluecol <- getIndexSQLName(x,margin=3)
        D <- reshape2::dcast(D, paste0(toupper(vobsidcol),
                             " ~ ",
                             toupper(vvaridcol)),
                   value.var = toupper(vvaluecol))
    } 
    i <- charmatch(rownames(x),D[[toupper(vobsidcol)]],nomatch=0)
                                        # print(i)
    D <- D[i,]
    if(any(D[[toupper(vobsidcol)]]!=1:nrow(D)))
        rownames(D) <- D[[toupper(vobsidcol)]]
    D[[toupper(vobsidcol)]] <- NULL
    ## For sparse deep table
    D[is.na(D)] <- 0
    if(!isDeep(x))
        names(D) <- vnames
    return(D)
}

#' @export
as.data.frame.FLVector <- function(x, ...){
    sqlstr <- constructSelect(x)
    sqlstr <- gsub("'%insertIDhere%'",1,sqlstr)

   tryCatch(D <- sqlQuery(getFLConnection(x),sqlstr),
      error=function(e){stop(e)})
   
    names(D) <- toupper(names(D))

    x <- populateDimnames(x)
    vrownames <- rownames(x)
    vcolnames <- colnames(x)
    # if(ncol(x)<=1 && !(!isDeep(x) && nrow(x)==1 && ncol(x)==1))
    #if(ncol(x)<=1 && class(x@select)!="FLTableFunctionQuery")
    if(ncol(x)<=1)
    {

        if(length(vrownames)==0 && length(x)>0)
            vrownames <- 1:length(x)
        if(is.character(rownames(x)) && !all(rownames(x)==1:length(rownames(x))))
            vrownames<-1:length(rownames(x))
        if(is.character(colnames(x)) && !all(colnames(x)==1:length(colnames(x))))
            vcolnames<-1:length(colnames(x))
    }

     i <- charmatch(vrownames,D[[toupper("vectorIndexColumn")]],nomatch=0)
     if(isDeep(x)) {
        if(length(colnames(x))>1)
        i <- charmatch(vcolnames,D[[toupper("vectorIndexColumn")]],nomatch=0)
    }
    D <- D[i,]
    if(isDeep(x)) {
        if(length(colnames(x))>1)
         D <- reshape2::dcast(D, paste0(toupper("vectorIdColumn"),
                             " ~ ",
                             toupper("vectorIndexColumn")),
                   value.var = toupper("vectorValueColumn"))
    }
    if(any(D[[toupper("vectorIndexColumn")]]!=1:nrow(D)))
        rownames(D) <- renameDuplicates(D[[toupper("vectorIndexColumn")]])
    D[[toupper("vectorIndexColumn")]] <- NULL
    D[[toupper("vectorIdColumn")]] <- NULL
    return(D)
}

#' @export
as.data.frame.FLMatrix <- function(x,...)
{
  temp_m <- as.matrix(x)
  return(as.data.frame(temp_m))
}

#' @export
as.data.frame.FLTableMD <- function(x,head=TRUE,...){
    if(head)
        n <- 6
    else{
        n <- max(unlist(dim(x)[[2]]))
    }
    return(head(x=x,n=n,...))
}

##############################################################################################################
#' Converts in-database objects to a matrix in R
#' 
#' Caution: data is fetched into R session
#' @param x can be FLTable, FLVector or FLMatrix
#' @return R matrix object
#' @export
as.matrix <- function(x, ...)
{
	UseMethod("as.matrix",x)
}

#' @export
as.matrix.data.frame <- base::as.matrix.data.frame
#' @export
as.matrix.integer <- base::as.matrix.default
#' @export
as.matrix.numeric <- base::as.matrix.default


#' Converts input FLMatrix object to matrix in R
#' @export
as.matrix.sparseMatrix <- function(object,sparse=FALSE) {
    if(sparse)
        return(object)
    dn <- dimnames(object)
    if(is.null(dn[[1]]) & is.null(dn[[2]]))
        matrix(as.vector(object),
               nrow(object),
               ncol(object))
    else matrix(as.vector(object),
                nrow(object),
                ncol(object),
                dimnames=dn)
}

## #' Converts input FLMatrix object to matrix in R
#' @export
as.matrix.FLMatrix <- function(object,sparse=FALSE) {
    m <- as.sparseMatrix(object)
    if(sparse)
        m
    dn <- dimnames(m)
    if(is.null(dn[[1]]) & is.null(dn[[2]]))
        matrix(as.vector(m),
                nrow(m),
                ncol(m))
    else matrix(as.vector(m),
                nrow(m),
                ncol(m),
                dimnames=dn)
}

#' @export
as.matrix.FLMatrixBind <- as.matrix.FLMatrix


#' Converts FLVector object to a matrix in R
#' @export
as.matrix.FLVector <- function(obj)
{
	Rvector <- as.vector(obj)
	return(as.matrix(Rvector))
}

#' @export
as.matrix.FLTable <- function(x,...)
{
  temp_df <- as.data.frame(x)
  return(as.matrix(temp_df))
}


###############################################################################################################

#' @export
as.FLMatrix.Matrix <- function(object,sparse=TRUE,connection=NULL,...) {
    if(!is.logical(sparse)) stop("sparse must be logical")
    if(is.null(connection)) connection <- getFLConnection(object)
    options(warn=-1)
    if(is.integer(as.vector(as.matrix(object))))
    tablename <- getOption("ResultIntMatrixTableFL")
    else if(is.numeric(as.vector(as.matrix(object))))
    tablename <- getOption("ResultMatrixTableFL")
    else if(is.character(as.vector(as.matrix(object))))
    tablename <- getOption("ResultCharMatrixTableFL")
    else stop("only integer,numeric and character type matrices allowed in as.FLMatrix\n")
    
        mwide <- Matrix::Matrix(object, sparse=TRUE)
        if(class(mwide)=="dsCMatrix")
        mwide <- as(mwide,"dgTMatrix")
        mdeep <- Matrix::summary(mwide)
        ## check for empty rows or columns
        ## and add a 0
        fillEmptyDims <- function(mdeep,dims)
        {
          i<-setdiff(1:dims[1],mdeep$i)
          j<-setdiff(1:dims[2],mdeep$j)
          ir<-c(rep(i[1],length(j)),i)
          jr<-c(j,rep(j[1],length(i)))
          if(length(ir)==0 && length(jr)==0) return(mdeep)
          if(is.na(ir)) ir <- rep(dims[1],length(jr))
          if(is.na(jr)) jr <- rep(dims[2],length(ir))
          sr <- Matrix::summary(Matrix::sparseMatrix(i=ir,j=jr,x=0))
          return(base::rbind(mdeep,sr))
        }
        mdeep <- fillEmptyDims(mdeep,dims=dim(object))
        ## insert one 0 at nrow,ncol for
        ## "storing" matrix dimensions
        # if(object[nrow(object),ncol(object)]==0)
        #     mdeep <- base::rbind(mdeep,
        #                    c(i=nrow(object),j=ncol(object),
        #                      x=0))
        MID <- getMaxMatrixId(vconnection=connection,
                              vtable=tablename)
        remoteTable <- tablename

        #analysisID <- paste0("AdapteR",remoteTable,MID)
        # if(is.ODBC())
        # {
        #   sqlstatements <-
        #     base::apply(mdeep,1,
        #                 function(r)
        #                     paste0(" INSERT INTO ",
        #                            remoteTable,
        #                            " (matrix_id, rowIdColumn, colIdColumn, valueColumn) VALUES (",
        #                            paste0(c(MID,r), collapse=", "),
        #                            ");"))
        # ##flag1Check(connection)
        # retobj<-sqlSendUpdate(connection,
        #                       paste(sqlstatements,
        #                             collapse="\n"))
        # }
        # else if(is.JDBC())
        # {
          mdeep <- base::cbind(MATRIX_ID=as.integer(MID),mdeep)
          mdeep <- as.data.frame(mdeep)
          colnames(mdeep) <- c("MATRIX_ID","rowIdColumn","colIdColumn","valueColumn")
          if(tablename==getOption("ResultIntMatrixTableFL"))
            mdeep[["valueColumn"]] <- as.integer(mdeep[["valueColumn"]])
          t <- as.FLTable.data.frame(mdeep,connection,
                                    tablename,1,drop=FALSE)
        # }
        mydimnames <- dimnames(object)
        mydims <- dim(object)
        ##print(mydimnames)
        
        mapTable <- NULL
        for(i in 1:length(mydimnames))
            if(is.character(mydimnames[[i]])){
                mapTable <- getOption("NameMapTableFL")
                mydimnames[[i]] <- storeVarnameMapping(
                    connection,
                    mapTable,
                    MID,
                    i,
                    mydimnames[[i]])
            }

        return(FLMatrix(
            connection = connection,
            table_name = tablename,
            map_table = mapTable,
            matrix_id_value = MID,
            matrix_id_colname = "MATRIX_ID",
            row_id_colname = "rowIdColumn",
            col_id_colname = "colIdColumn",
            cell_val_colname = "valueColumn",
            dims = mydims,
            dimnames = mydimnames))
}

#' Casting to FLMatrix
#'
#' Converts input to a FLMatrix object
##' @param object matrix, vector, data frame, sparseMatrix, FLVector which
##' needs to be casted to FLMatrix and inserted in-database
##' @param connection ODBC/JDBC connection object
##' @param sparse logical if sparse representation to be used
##' @param ... additional arguments like nr number of rows in resulting FLMatrix
##' nc number of columns in resulting FLMatrix.
##' nr and nc inputs are applicable only in case of vector,FLVector
#' @return FLMatrix object after casting.
#' @export

setGeneric("as.FLMatrix", function(object,sparse=TRUE,...) {
    standardGeneric("as.FLMatrix")
})
setMethod("as.FLMatrix", signature(object = "matrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "matrix",
                                   sparse="logical"),
          function(object,sparse)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dgeMatrix",
                                   sparse="logical"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dgeMatrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dgCMatrix",
                                   sparse="logical"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dgCMatrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dgTMatrix",
                                   sparse="logical"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dgTMatrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dsCMatrix",
                                   sparse="logical"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dsCMatrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "dtCMatrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))

setMethod("as.FLMatrix", signature(object = "dpoMatrix",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.Matrix(object,sparse=sparse))
###########################################################################
setMethod("as.FLMatrix", signature(object = "vector",
                                   sparse="logical"),
          function(object,sparse=TRUE,rows=length(object),cols=1,...)
              as.FLMatrix.vector(object,sparse,rows,cols,...))
setMethod("as.FLMatrix", signature(object = "vector",
                                   sparse="missing"),
          function(object,sparse=TRUE,rows=length(object),cols=1,...)
              as.FLMatrix.vector(object,sparse=TRUE,rows,cols,...))
setMethod("as.FLMatrix", signature(object = "data.frame",
                                   sparse="logical"),
          function(object,sparse=TRUE)
              as.FLMatrix.data.frame(object,sparse=sparse))
setMethod("as.FLMatrix", signature(object = "data.frame",
                                   sparse="missing"),
          function(object,sparse=TRUE)
              as.FLMatrix.data.frame(object,sparse=TRUE))
setMethod("as.FLMatrix", signature(object = "FLVector",
                                   sparse="logical"),
          function(object,sparse=TRUE,...)
              as.FLMatrix.FLVector(object,sparse,...))
setMethod("as.FLMatrix", signature(object = "FLVector",
                                   sparse="missing"),
          function(object,sparse=TRUE,...)
              as.FLMatrix.FLVector(object,sparse=TRUE,...))

setMethod("as.FLMatrix",signature(object="FLTable"),
          function(object,sparse=TRUE,...)
            as.FLMatrix.FLTable(object=object,
                                sparse=sparse,...))
###########################################################################


#' @export
setGeneric("as.R", function(flobject) standardGeneric("as.R"))
setMethod("as.R","FLMatrix", function(flobject) as.matrix(flobject))
setMethod("as.R","FLTable", function(flobject) as.data.frame(flobject))
setMethod("as.R","environment", function(flobject) as.REnvironment(flobject))
setMethod("as.R","FLVector", function(flobject) as.vector(flobject))

#' @export
setGeneric("as.FL", function(object,...) standardGeneric("as.FL"))
setMethod("as.FL","numeric", function(object,...) as.FLVector(object,...))
setMethod("as.FL","complex", function(object,...) stop("complex numbers not currently supported."))
setMethod("as.FL","character", function(object,...) as.FLVector(object,...))
setMethod("as.FL","vector", function(object,...) as.FLVector(object,...))
setMethod("as.FL","matrix", function(object,...) as.FLMatrix(object,...))
setMethod("as.FL","dpoMatrix", function(object,...) as.FLMatrix(object,...))
setMethod("as.FL","dsCMatrix", function(object,...) as.FLMatrix(object,...))
setMethod("as.FL","dgCMatrix", function(object,...) as.FLMatrix(object,...))
setMethod("as.FL","dgeMatrix", function(object,...) as.FLMatrix(object,...))
setMethod("as.FL","data.frame", function(object,...) as.FLTable(object,...))
setMethod("as.FL","environment", function(object,...) as.FLEnvironment(object,...))

as.REnvironment<-function(FLenv){
  Renv<-new.env()
  for(n in ls(FLenv)){
      object <- get(n,envir = FLenv)
      assign(n, as.R(object), envir=Renv)
  }
  return(Renv)
}

as.FLEnvironment <- function(Renv){
    FLenv <- new.env(parent = parent.env(Renv))
    for(n in ls(envir = Renv)){
        object <- get(n,envir = Renv)
        assign(n, as.FL(object), envir=FLenv)
    }
    FLenv
}

#' @export
as.sparseMatrix <- function(object)
    UseMethod("as.sparseMatrix")

#' @export
as.sparseMatrix.FLMatrix <- function(object) {
    sqlstr <- gsub("'%insertIDhere%'",1,constructSelect(object, joinNames=FALSE))
    tryCatch(valuedf <- sqlQuery(getFLConnection(object), sqlstr),
      error=function(e){stop(e)})

    ##@phani: Aster and hadoop return output schema in lower case.
    colnames(valuedf) <- tolower(colnames(valuedf))

    i <- valuedf[[tolower(object@dimColumns[[2]])]]
    j <- valuedf[[tolower(object@dimColumns[[3]])]]
    i <- FLIndexOf(i,rownames(object))
    j <- FLIndexOf(j,colnames(object))

    dn <- dimnames(object)
    if(any(is.na(c(i,j))))
            browser()
        
    values <- valuedf[[tolower(object@dimColumns[[4]])]]

    ##@phani:- some connection drivers give boolean as character
    if(typeof(object)=="logical" &&
        !any(is.na(as.logical(values))))
        values <- as.logical(values)

  if(is.factor(values))
  return(matrix(values,dim(object),
          dimnames=dn))
  else if(is.logical(values)){
    vsummary <- base::rbind(Matrix::summary(Matrix(TRUE,
                                                dim(object)[1],
                                                dim(object)[2],
                                                sparse=TRUE)),
                            Matrix::summary(Matrix::sparseMatrix(i=i,
                              j=j,
                              x=values,
                              dims=dim(object)))
                            )
    vsparseRes <- Matrix::sparseMatrix(i=vsummary$i,
                                      j=vsummary$j,
                                      x=vsummary$x,
                                      dims=dim(object),
                                      dimnames=dn,
                                      use.last.ij = TRUE)
    return(matrix(vsparseRes,
                  dim(object),
                  dimnames=dn))
  }

  if(is.null(values))
      m <- Matrix::sparseMatrix(i = i,
                        j = j,
                        x = i,
                        dims = dim(object),
                        dimnames = dn)
  else if(is.null(dn[[1]]) & is.null(dn[[2]]))
      m <- Matrix::sparseMatrix(i = i,
                        j = j,
                        x = values,
                        dims = dim(object))
  else
      m <- Matrix::sparseMatrix(i = i,
                        j = j,
                        x = values,
                        dims = dim(object),
                        dimnames = dn)
  return(m)
}
#' @export
as.sparseMatrix.FLMatrix.TDAster <- function(object){
    object <- setValueSQLName(object,tolower(getValueSQLName(object)))
    object <- setIndexSQLName(object=object,
                            margin=1:2,
                            value=tolower(getIndexSQLName(object,margin=1:2)))
    as.sparseMatrix.FLMatrix(object)
}
#' @export
as.sparseMatrix.FLMatrix.Hadoop <- as.sparseMatrix.FLMatrix.TDAster
#' @export
as.FLMatrix.FLVector <- function(object,sparse=TRUE,
                rows=length(object),cols=1,connection=NULL)
{
  if(is.null(connection)) connection <- getFLConnection(object)
  ##Get names of vector
  if(ncol(object)>1)
  object <- store(object)

  if(ncol(object)==1) vnames <- object@Dimnames[[1]]
  else vnames <- object@Dimnames[[2]]

  if(class(object@select)=="FLTableFunctionQuery"
    && !all(vnames==1:length(vnames)))
  object <- store(object)

  if(!missing(rows) && missing(cols) && rows!=length(object))
  cols <- base::ceiling(length(object)/rows)
  if(!missing(cols) && missing(rows) && cols!=1)
  rows <- base::ceiling(length(object)/cols)

  k <- base::ceiling((rows*cols)/length(object))-1
  a<-genRandVarName()
  # sqlstr <- paste0(" SELECT '%insertIDhere%' AS MATRIX_ID,",
  #                            a,".vectorIndexColumn + ",(0:k)*length(object),
  #                            " - (CAST((",a,".vectorIndexColumn + ",(0:k)*length(object),
  #                             "-0.355)/",rows," AS INT)*",rows,") AS rowIdColumn,",
  #                           " CAST((",a,".vectorIndexColumn + ",(0:k)*length(object),
  #                             "-0.355)/",rows," AS INT)+1 AS colIdColumn,",
  #                            a,".vectorValueColumn AS valueColumn",
  #                   " FROM(",constructSelect(object),") AS ",a,
  #                   " WHERE ",a,".vectorIndexColumn + ",(0:k)*length(object)," <= ",rows*cols)
  sqlstr <- paste0(" SELECT '%insertIDhere%' AS MATRIX_ID,",
                             "a.vectorIndexColumn + ",(0:k)*length(object),
                             " - (FLTrunc((a.vectorIndexColumn + ",(0:k)*length(object),
                              "-0.355)/",rows,",0)*",rows,") AS rowIdColumn,",
                            " FLTrunc((a.vectorIndexColumn + ",(0:k)*length(object),
                              "-0.355)/",rows,",0)+1 AS colIdColumn,",
                            "a.vectorValueColumn AS valueColumn",
                    " FROM(",constructSelect(object),") AS a ",
                    " WHERE a.vectorIndexColumn + ",(0:k)*length(object)," <= ",rows*cols)

  batchStore <- function(sqlstr,MID)
  {
    if(utils::object.size(paste0(sqlstr,collapse=" UNION ALL "))>300000)
    {
      newindex <- base::ceiling(length(sqlstr)/2)
      batchStore(sqlstr[1:newindex],MID)
      batchStore(sqlstr[(newindex+1):length(sqlstr)],MID)
    }
    else
    {
      sqlstr <- paste0(sqlstr,collapse=" UNION ALL ")
      # vSqlStr <- paste0(" INSERT INTO ", getOption("ResultMatrixTableFL"),
      #               "\n",
      #              gsub("'%insertIDhere%'",MID,sqlstr),
      #               "\n")
      # sqlSendUpdate(connection,vSqlStr)
      insertIntotbl(pTableName=getOption("ResultMatrixTableFL"),
                    pSelect=gsub("'%insertIDhere%'",MID,sqlstr))
    }
  }

  if(utils::object.size(paste0(sqlstr,collapse=" UNION ALL "))>300000)
  {
    MID <- getMaxMatrixId(connection)
    batchStore(sqlstr,MID)
    return(FLMatrix(
            table_name = getOption("ResultMatrixTableFL"),
            map_table = NULL,
            matrix_id_value = MID,
            matrix_id_colname = "MATRIX_ID",
            row_id_colname = "rowIdColumn",
            col_id_colname = "colIdColumn",
            cell_val_colname = "valueColumn",
            connection = connection
            ))
  }

  sqlstr <- paste0(sqlstr,collapse=" UNION ALL ")
  tblfunqueryobj <- new("FLTableFunctionQuery",
                        connectionName = attr(connection,"name"),
                        variables=list(
                            rowIdColumn="rowIdColumn",
                            colIdColumn="colIdColumn",
                            valueColumn="valueColumn"),
                        whereconditions="",
                        order = "",
                        SQLquery=sqlstr)

  flm <- newFLMatrix(
              select= tblfunqueryobj,
              dims = as.integer(c(rows,cols)),
              Dimnames=list(1:rows,1:cols),
              type=typeof(object))
  return(flm)
}

#' @export
as.FLMatrix.vector <- function(object,
                               sparse=TRUE,
                               rows=length(object),
                               cols=1,
                               connection=NULL
                               )
{
  temp_m <- Matrix::Matrix(object,rows,cols,sparse=TRUE)
  return(as.FLMatrix(temp_m))
}

#' @export
as.FLMatrix.data.frame <- function(object,
                                   sparse=TRUE,
                                   connection=NULL)
{
  temp_m <- Matrix::Matrix(as.matrix(object),sparse=TRUE)
  return(as.FLMatrix(temp_m))
}

as.FLMatrix.FLTable <- function(object,
                                sparse=TRUE,...){
  object <- setAlias(object,"")
  if(!isDeep(object))
  object <- wideToDeep(object=object)

  vdimnames <- lapply(dimnames(object),
                  function(x){
                      if(all(x==1:length(x)))
                      return(NULL)
                      else return(x)
                  })
  return(FLMatrix(table_name=getTableNameSlot(object),
                  row_id_colname=getVariables(object)[["obs_id_colname"]],
                  col_id_colname=getVariables(object)[["var_id_colname"]],
                  cell_val_colname=getVariables(object)[["cell_val_colname"]],
                  dimnames=vdimnames,
                  whereconditions=object@select@whereconditions))
}
######################################################################################################################
#' casting to FLVector
#'
#' Converts input \code{obj} to FLVector object
#' @param object matrix, vector, data frame, sparseMatrix, FLMatrix which
#' needs to be casted to FLVector
#' @param connection ODBC/JDBC connection object
#' @param ... additional arguments like size
#' @param size number of elements in resulting FLVector.
#' size input is not applicable only in case of FLMatrix
#' @return FLVector object after casting.
#' @export
setGeneric("as.FLVector", function(object,...) {
    standardGeneric("as.FLVector")
})
setMethod("as.FLVector", signature(object = "vector"),
          function(object,connection)
              as.FLVector.vector(object))
setMethod("as.FLVector", signature(object = "matrix"),
          function(object,connection)
              as.FLVector.vector(object))
setMethod("as.FLVector", signature(object = "dgeMatrix"),
          function(object,connection)
              as.FLVector.vector(object))
setMethod("as.FLVector", signature(object = "dgCMatrix"),
          function(object,connection)
              as.FLVector.vector(object))
setMethod("as.FLVector", signature(object = "dsCMatrix"),
          function(object,connection)
              as.FLVector.vector(object))
setMethod("as.FLVector", signature(object = "dgTMatrix"),
          function(object,connection)
              as.FLVector.vector(object))
setMethod("as.FLVector", signature(object = "data.frame"),
          function(object,connection)
              as.FLVector.vector(as.matrix(object)))
setMethod("as.FLVector", signature(object = "FLMatrix"),
          function(object,connection)
              as.FLVector.FLMatrix(object))
setMethod("as.FLVector", signature(object = "FLMatrix"),
          function(object)
              as.FLVector.FLMatrix(object))

#' @export
as.FLVector.vector <- function(object,connection=getFLConnection())
{
    ##flag3Check(connection)
  if(!is.null(names(object)) && !all(names(object)==1:length(object)))
  newnames <- as.character(names(object))
  else newnames <- 1:length(object)

  if(is.factor(object))
    object <- as.character(object)
  if(is.logical(object))
  tablename <- getOption("ResultCharVectorTableFL")
  else if(suppressWarnings(!any(is.na(as.integer(object))) && 
    all(as.integer(object)==object) &&
    !is.character(object))){
    tablename <- getOption("ResultIntVectorTableFL")
    object <- as.integer(object)
  }
  else if(is.numeric(object))
    tablename <- getOption("ResultVectorTableFL")
  else if(is.character(object))
    tablename <- getOption("ResultCharVectorTableFL")
  else stop("only numeric,integer and character vectors supported in as.FLVector")

  VID <- getMaxVectorId(connection,tablename)

  #vobjcopy <- ifelse(is.character(object),fquote(object[x]),object[x])
  #object <- c(1,"NULL")
  # if(is.ODBC())
  # {
  #   sqlstr<-sapply(1:length(object),FUN=function(x) paste0("INSERT INTO ",
  #          tablename,
  #          " SELECT ",VID," AS vectorIdColumn,",
  #                    x," AS vectorIndexColumn,",
  #                    ifelse(tablename==getOption("ResultCharVectorTableFL"),
  #                           fquote(object[x]),
  #                           object[x]),
  #                    " AS vectorValueColumn;"
  #                  ))
  #   retobj<-sqlSendUpdate(connection,
  #                             paste(sqlstr,
  #                                   collapse="\n"))
  # }
  # else if(is.JDBC())
  # {
    #browser()
    vdataframe <- data.frame(vectorIdColumn=as.integer(VID),
                            vectorIndexColumn=as.integer(1:length(object)),
                            vectorValueColumn=as.vector(object))
    t <- as.FLTable.data.frame(vdataframe,connection,tablename,1,drop=FALSE)
  # }
  select <- new("FLSelectFrom",
                connectionName = attr(connection,"name"), 
                table_name = c(flt=tablename),
                variables = list(
                        obs_id_colname = "flt.vectorIndexColumn"),
                # whereconditions=paste0(tablename,".vectorIdColumn = ",VID),
                whereconditions=paste0("flt.vectorIdColumn = ",VID),
                order = "")

  return(newFLVector(
                select=select,
                Dimnames=list(newnames,"vectorValueColumn"),
                isDeep=FALSE,
                type=typeof(object)))
}

#' @export
as.FLVector.FLMatrix <- function(object,connection=getFLConnection(object))
{
    ##flag3Check(connection)
  VID <- getMaxVectorId(connection)
  k <- 1
  sqlstr <- ""
  batchStore <- function(sqlstr)
  {
    sqlstr <- sqlstr[sqlstr!=""]
    sqlstr <- paste0(sqlstr,collapse=" UNION ALL ")
    # vSqlStr <- paste0(" INSERT INTO ",getOption("ResultVectorTableFL"),
    #                 "\n",
    #                gsub("'%insertIDhere%'",VID,sqlstr),
    #                 "\n")
    # sqlSendUpdate(connection,
    #               vSqlStr)
    insertIntotbl(pTableName=getOption("ResultVectorTableFL"),
                    pSelect=gsub("'%insertIDhere%'",VID,sqlstr))
  }
  colnames <- colnames(object)
  if(is.null(colnames(object))) 
  colnames <- 1:object@dims[[2]]
  else if(!is.null(names(colnames)))
  colnames <- names(colnames)
  object@Dimnames[[2]] <- colnames

  rownames <- rownames(object)
  if(is.null(rownames(object))) 
  rownames <- 1:object@dims[[1]]
  else if(!is.null(names(rownames)))
  rownames <- names(rownames)
  object@Dimnames[[1]] <- rownames
  ## FOR loop used only for generating SQL query.
  for(i in colnames)
  {
    a <- genRandVarName()
    sqlstr0 <- paste0(" SELECT '%insertIDhere%' AS vectorIdColumn,",
                              k:(k+length(rownames(object))-1)," AS vectorIndexColumn,",
                              a,".valueColumn AS vectorValueColumn 
                       FROM(",constructSelect(object),") AS ",a,
                       " WHERE (",a,".",object@dimColumns[[2]]," = ",rownames(object),
                         ") AND (",a,".",object@dimColumns[[3]]," = ",i,") ")
    sqlstr <- c(sqlstr,sqlstr0)
    if(checkQueryLimits(sqlstr) && i!=colnames[length(colnames)])
    {
      batchStore(sqlstr)
      sqlstr <- ""
    }
    k <- k+length(rownames(object))
  }
    batchStore(sqlstr)
    sqlstr <- ""
    table <- FLTable(connection = getFLConnection(object),
                     table=getOption("ResultVectorTableFL"),
                     obs_id_colname="vectorIndexColumn",
                     whereconditions=paste0(getOption("ResultVectorTableFL"),".vectorIdColumn = ",VID)
                     )

    return(table[,"vectorValueColumn"])
}

#####################################################################################################################
#' casting to FLTable
#'
#' Converts input \code{obj} to FLVector object
#' @param object data frame which
#' needs to be casted to FLTable
#' @param connection ODBC/JDBC connection object
#' @param ... additional arguments like size
#' @return FLTable object after casting.
#' @export
setGeneric("as.FLTable", function(object,...) {
    standardGeneric("as.FLTable")
})
setMethod("as.FLTable", signature(object = "data.frame"),
          function(object,...)
              as.FLTable.data.frame(object,...))
setMethod("as.FLTable",signature(object="FLMatrix"),
          function(object,...)
          as.FLTable.FLMatrix(object=object,...))


as.FLTable.FLMatrix <- function(object=object,...){
    object <- setAlias(object,"")
    return(FLTable(table=getTableNameSlot(object),
                   obs_id_colname=getVariables(object)[["rowIdColumn"]],
                   var_id_colnames=getVariables(object)[["colIdColumn"]],
                   cell_val_colname=getVariables(object)[["valueColumn"]],
                   whereconditions=object@select@whereconditions))
}
#' @export
as.FLTable.data.frame <- function(object,
                                  connection=getFLConnection(),
                                  tableName,
                                  uniqueIdColumn=0,
                                  drop=TRUE,
                                  batchSize=10000,
                                  temporary=getOption("temporaryFL")){
  if(missing(tableName))
  tableName <- gen_wide_table_name("a")
  if(uniqueIdColumn==0 && is.null(rownames(object)) || length(rownames(object))==0)
  stop("please provide primary key of the table as rownames when uniqueIdColumn=0")
  if(uniqueIdColumn==0){
    vrownames <- rownames(object)
    if(is.null(vrownames))
        vrownames <- as.integer(1:nrow(object))
    if(!any(is.na(as.integer(vrownames))))
        vrownames <- as.integer(vrownames)
    else{
      warning("rownames are non-integers to be used as uniqueIdColumn. using continuous integers \n ")
      vrownames <- as.integer(1:nrow(object))
    }
    object <- base::cbind(obsid=vrownames,object)
    obsIdColname <- "obsid"
  }
  else if(is.numeric(uniqueIdColumn)){
    uniqueIdColumn <- as.integer(uniqueIdColumn)
    if(uniqueIdColumn < 0 || uniqueIdColumn > ncol(object))
        stop("uniqueIdColumn is out of bounds")
    else
        obsIdColname <- colnames(object)[uniqueIdColumn]
  }
  else if(is.character(uniqueIdColumn)){
    if(!uniqueIdColumn %in% colnames(object))
        stop("uniqueIdColumn is out of bounds")
    else
        obsIdColname <- uniqueIdColumn
  }

    ## If integers in obsIdColumn, cast it to INT
    if(!is.integer(object[[obsIdColname]]) &&
        all(object[[obsIdColname]]==as.integer(object[[obsIdColname]])))
    object[[obsIdColname]] <- as.integer(object[[obsIdColname]])

    ## A copy of connection is needed as in Aster, if query fails
    ## connection becomes unusable until end of transaction block.
    vconnection <- getRConnection(connection)
    vcols <- ncol(object)
    #vcolnames <- apply(object,2,class) ## wrong results with apply!
    vcolnames <- c()
    #browser()
    for(i in 1:vcols)
    vcolnames <- c(vcolnames,class(object[[i]]))
    names(vcolnames) <- colnames(object)
    # Changing any factors to characters
    object[,vcolnames=="factor"] <- apply(as.data.frame(object[,vcolnames=="factor"]),
                                    2,as.character)
    object[,as.logical(vcolnames=="logical")] <- apply(as.data.frame(object[,as.logical(vcolnames=="logical")]),
                                                        2,as.character)
    vcolnames[vcolnames=="factor"] <- "character"
    # Removing "." if any from colnames
    names(vcolnames) <- gsub("\\.","",names(vcolnames),fixed=FALSE)
    # vcolnamesCopy <- vcolnames
    # vcolnamesCopy[vcolnamesCopy=="character"] <- "VARCHAR(255)"
    # vcolnamesCopy[vcolnamesCopy=="numeric"] <- "FLOAT"
    # vcolnamesCopy[vcolnamesCopy=="integer"] <- "INT"
    # vcolnamesCopy[vcolnamesCopy=="logical"] <- "VARCHAR(255)"
    # if(!all(vcolnamesCopy %in% c("VARCHAR(255)","INT","FLOAT"))==TRUE)
    # stop("currently class(colnames(object)) can be only character,numeric,integer. Use casting if possible")
    vcolnamesCopy <- getRToFLDataTypeMap(vcolnames)
    
    if(!checkRemoteTableExistence(tableName=tableName) | drop)
        tryCatch({
            t <- createTable(pTableName=tableName,
                             pColNames=names(vcolnamesCopy),
                             pColTypes=vcolnamesCopy,
                             pTemporary=temporary,
                             pDrop=drop
                             )},
            error=function(e)NULL)
    if(is.ODBC(vconnection) || is.Hadoop()|| class(vconnection) == "ODBCConnection")
    {
    ## SqlSave uses parameterized sql which is slow for odbc.
    ## SqlSave does not include distribute by during table creation.
    ## SqlSave with append=TRUE crashes R session for Aster.
    # tryCatch(RODBC::sqlSave(channel=connection,
    #                         dat=object,
    #                         tablename=tableName,
    #                         rownames=FALSE),
    #   error=function(e){stop(e)})
       
    ## This bulk insertion may fail for very big data
    ## as there size of query fired may exceed odbc limits!
    ## These cases will be handled by Parameterized sql
    ## Replace NAs with NULL
    object[is.na(object)] <- ''
    vresult <- tryCatch({
                        ## Add batch insert for ODBC
                        if(batchSize>10000)
                        {
                            batchSize <- 10000
                            warning("using max batchSize=10000")
                        }
                        for(i in 1:ceiling(nrow(object)/batchSize)){
                            if(getOption("debugSQL"))
                                cat(paste0("inserting batch: ",i, " of ",
                                           ceiling(nrow(object)/batchSize),
                                           "\n"))
                            vlower <- 1+((i-1)*batchSize)
                            vupper <- i*batchSize
                            if(vupper>nrow(object))
                                vupper <- nrow(object)
                            insertIntotbl(pTableName=tableName,
                                        pValues=object[vlower:vupper,])
                        }
                        },
                        error=function(e){
                            if(!is.ODBC(vconnection)) stop(e)
                            sqlstr <- paste0("INSERT INTO ",tableName,
                                            " VALUES(",paste0(rep("?",vcols),
                                            collapse=","),")")
                            sqlExecute(vconnection,sqlstr,object)
                        })
  }
  else if(is.JDBC(vconnection))
  {
    .jcall(vconnection@jc,"V","setAutoCommit",FALSE)
    sqlstr <- paste0("INSERT INTO ",
                tableName," VALUES(",paste0(rep("?",vcols),collapse=","),")")
    ps = .jcall(vconnection@jc,"Ljava/sql/PreparedStatement;","prepareStatement",sqlstr)
    myinsert <- function(namedvector,x){
                  vsetvector <- c("VARCHAR(255)"="setString",
                                  "FLOAT"="setFloat",
                                  "INT"="setInt")
                  for(i in 1:length(namedvector))
                  {
                      if(namedvector[i]=="VARCHAR(255)")
                          val <- as.character(x[i])
                      else if(namedvector[i]=="FLOAT")
                          val <- .jfloat(x[i])
                      else
                          val <- as.integer(x[i])
                      .jcall(ps,"V",vsetvector[namedvector[i]],
                             as.integer(i),val)
                  }
                  .jcall(ps,"V","addBatch")
                }
    ##Chunking
    {
      if(batchSize>10000)
      {
        batchSize <- 10000
        warning("using max batchSize=10000")
      }
      k <- 1
      vnrow <- nrow(object)
      while(k <= vnrow)
      {
        j <- k + (batchSize-1)
        if(j > vnrow) j <- vnrow
        vsubset <- object[k:j,]
        apply(vsubset,1,function(x) myinsert(vcolnamesCopy,x))
        tryCatch(.jcall(ps,"[I","executeBatch"),
                 error=function(e){stop("may be repeating primary key or bad column format.Error mssg recieved is:",e)})
        RJDBC::dbCommit(vconnection)
        k <- k + batchSize
      }
    }
    .jcall(vconnection@jc,"V","setAutoCommit",TRUE)
  }
  vcolnames <- names(vcolnames)
  # browser()
  select <- new("FLSelectFrom",
                connectionName = getFLConnectionName(), 
                table_name = tableName, 
                variables = list(
                    obs_id_colname = obsIdColname),
                ## var_id_colname = var_id_colnames,
                ## cell_val_colname = cell_val_colname),
                whereconditions=character(0),
                order = "")

  return(newFLTable(
              select = select,
              Dimnames = list(object[,obsIdColname],
                              vcolnames),
              dims=dim(object),
              isDeep = FALSE,
              type=sapply(object,typeof)))
}

as.FLByteInt <- function(x){
    vtbl <- getOption("ResultByteIntVectorTableFL")
    VID <- getMaxVectorId(getFLConnection(),
                          vtbl)
    vsqlstr <- constructSelect(x)
    vsqlstr <- gsub("'%insertIDhere%'",VID,vsqlstr)
    vtemp <- insertIntotbl(vtbl,
                            pSelect=vsqlstr)
    if(!vtemp)
        stop("invalid input: x and y should be of BYTEINT in-database type \n ")
    select <- new("FLSelectFrom",
                connectionName = getFLConnectionName(), 
                table_name = c(flt=vtbl),
                variables = list(
                        obs_id_colname = "flt.vectorIndexColumn"),
                whereconditions=paste0("flt.vectorIdColumn = ",VID),
                order = "")

    return(newFLVector(
                select=select,
                Dimnames=list(x@Dimnames[[1]],
                            "vectorValueColumn"),
                isDeep=FALSE,
                type="integer"))
}

setGeneric("populateDimnames",
    function(x,...){
        standardGeneric("populateDimnames")
        })

setMethod("populateDimnames",
    signature(x="ANY"),
    function(x,...){
        if(!length(x@Dimnames[[1]])>0)
            x@Dimnames[[1]] <- 1:(x@dims[1])
        if(isDeep(x))
            x@Dimnames[[2]] <- 1:(x@dims[2])
        return(x)
})