#### ------- All "Ops"  group methods for all Matrix classes ------------
###               ===
### Note that the "Ops" group consists of
### sub-groups   "Arith", "Compare", and "Logic"
###               -----    -------        -----
### where 'Arith'   :=  '"+"', '"-"', '"*"', '"^"', '"%%"', '"%/%"', '"/"'
###       'Compare' := '"=="', '">"', '"<"', '"!="', '"<="', '">="'
###       'Logic'   :=  '"&"', '"|"'  (( but *not* '"!"' since that has
###			                 only one argument ))

## in shell, find them with
##    egrep 'Method\("(Ops|Compare|Arith|Logic)"' R/*R

### "Ops" ---- remember Ops = {Arith, Compare, Logic}  [Logic: since R 2.4.1]
### -----


### Note: diagonalMatrix are handled by special methods -> ./diagMatrix.R
###       --------------                                   ~~~~~~~~~~~~~~


### --  0 -- (not dense *or* sparse) -----------------------------------

##-------- originally from ./Matrix.R --------------------

## Some ``Univariate'' "Arith":
setMethod("+", signature(e1 = "Matrix", e2 = "missing"), function(e1) e1)
## "fallback":
setMethod("-", signature(e1 = "Matrix", e2 = "missing"),
	  function(e1) {
	      warning("inefficient method used for \"- e1\"")
	      0-e1
	  })

## old-style matrices are made into new ones
setMethod("Ops", signature(e1 = "Matrix", e2 = "matrix"),
	  function(e1, e2) callGeneric(e1, Matrix(e2)))
##	    callGeneric(e1, Matrix(e2, sparse=is(e1,"sparseMatrix"))))
setMethod("Ops", signature(e1 = "matrix", e2 = "Matrix"),
	  function(e1, e2) callGeneric(Matrix(e1), e2))

## bail-outs -- on highest possible level, hence "Ops", not "Compare"/"Arith" :
setMethod("Ops", signature(e1 = "Matrix", e2 = "Matrix"),
          function(e1, e2) {
              d <- dimCheck(e1,e2)
              .bail.out.2(.Generic, class(e1), class(e2))
          })
setMethod("Ops", signature(e1 = "Matrix", e2 = "ANY"),
          function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2)))
setMethod("Ops", signature(e1 = "ANY", e2 = "Matrix"),
          function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2)))

## "General principle"
##  - - - - - - - - -
## For "Arith" it is sufficient (though not optimal, once we have "iMatrix"!)
## to define "dMatrix" methods and coerce all other "[nli]Matrix" to "dMatrix"
setMethod("Arith", signature(e1 = "Matrix", e2 = "Matrix"),
          function(e1, e2) callGeneric(as(e1, "dMatrix"), as(e2, "dMatrix")))

## For "Compare", this would be feasible too, but is clearly suboptimal,
## particularly for "==" and "!="
## and for "lMatrix" and "nMatrix"  should not coerce at all
## setMethod("Compare", signature(e1 = "Matrix", e2 = "Matrix"),
##           function(e1, e2) {
##               if(is.na(match(.Generic, c("==", "!="))))
##                   callGeneric(as(e1, "dMatrix"), as(e2, "dMatrix"))
##               else { ## no coercion needed for "==" or "!="
##               }
##           })


## Working entirely on "matching" x slot:
## can be done for matching-dim "*geMatrix", and also
## matching-{dim + uplo} for *packed* (only!) symmetric+triangular
.Ops.via.x <- function(e1,e2) {
    d <- dimCheck(e1, e2)
    e1@x <- callGeneric(e1@x, e2@x)
    e1
}


##-------- originally from ./dMatrix.R --------------------

## Note that there extra methods for <sparse> o <sparse> !
if(FALSE) ## use the (more sophisticated) "Ops" method below
setMethod("Arith", signature(e1 = "dMatrix", e2 = "dMatrix"),
          ##  "+", "-", "*", "^", "%%", "%/%", "/"
          ## Going -> dense* (= ddense*) -> dgeMatrix
	  function(e1, e2) {
	      d <- dimCheck(e1,e2)
	      callGeneric(as(e1, "denseMatrix"),
			  as(e2, "denseMatrix"))
	  })

## "Compare" -> returning  logical Matrices
setMethod("Compare", signature(e1 = "numeric", e2 = "dMatrix"),
	  function(e1,e2) {
	      ## "swap RHS and LHS" and use the method below:
	      switch(.Generic,
		     "==" =, "!=" = callGeneric(e2, e1),
		     "<"  = e2 >  e1,
		     "<=" = e2 >= e1,
		     ">"  = e2 <  e1,
		     ">=" = e2 <= e1)
	  })

setMethod("Compare", signature(e1 = "dMatrix", e2 = "numeric"),
	  function(e1, e2) { ## result will inherit from "lMatrix"
	      lClass <- class2(cl <- class(e1), "l")
              cl1 <- getClassDef(cl)
	      fullCl <-
                  if(extends(cl1, "symmetricMatrix")) "lsyMatrix" else "lgeMatrix"
	      r	 <- callGeneric(e1@x, e2)
	      r0 <- callGeneric(0, e2)
              d <- e1@Dim
	      ## trivial case first (beware of NA)
	      if(isTRUE(r0 && all(r))) {
		  r <- new(fullCl)
		  r@Dim <- d
		  r@Dimnames <- e1@Dimnames
		  r@x <- rep.int(TRUE, prod(d))
	      }
	      else if(extends(cl1, "denseMatrix")) {
		  full <- !isPacked(e1) # << both "dtr" and "dsy" are 'full'
		  if(full || identical(r0, FALSE) || extends(cl1,"symmetricMatrix"))
		      r <- new(lClass, x = r, Dim = d, Dimnames = dimnames(e1))
		  else { ## packed matrix with structural 0 and r0 is not FALSE:
		      ##--> result cannot be packed anymore
                      ## [dense & packed & not symmetric ] ==> must be "dtp*" :
                      if(!extends(cl1, "dtpMatrix"))
                          stop("internal bug in \"Compare\" method for \"dMatrix\"; please report")
                      rx <- rep.int(r0, d[1]*d[2])
                      rx[indTri(d[1], upper = (e1@uplo == "U"))] <- r
                      r <- new(fullCl, x = rx, Dim = d, Dimnames = dimnames(e1))
		  }

	      }
	      else { ## dsparseMatrix => lClass is "lsparse*"
		  if(extends(cl1, "triangularMatrix") && e1@diag == "U") {
		      e1 <- .diagU2N(e1, cl = cl1)
		      if(extends(cl1, "CsparseMatrix")) {
			  r <- callGeneric(e1@x, e2)
		      }
		      else {
			  ## CARE: assume that diagU2N appends the diagonal entries at end !
			  r <- c(r, rep.int(callGeneric(1, e2), d[1]))
		      }
		  }
		  if(identical(r0, FALSE)) { ## things remain sparse
		      if(!any(is.na(r)) && ((Ar <- all(r)) || !any(r))) {
			  r <- new(lClass)
			  r@Dim <- d
			  r@Dimnames <- dimnames(e1)
			  if(Ar) { # 'TRUE' instead of 'x': same sparsity:
			      r@x <- rep.int(TRUE, length(e1@x))
			      for(n in intersect(c("i","j","p"), slotNames(r)))
				  slot(r, n) <- slot(e1, n)
			  }
			  else { ## all FALSE: keep empty 'r' matrix
			      ## but may need a valid 'pointer' slot:
			      if(extends(lClass, "CsparseMatrix"))
				  r@p <- rep.int(0:0, 1+ncol(r))
			      else if(extends(lClass, "RsparseMatrix"))
				  r@p <- rep.int(0:0, 1+nrow(r))
			  }
		      } else { # some TRUE, FALSE, NA : go via unique 'Tsparse'
			  M <- asTuniq(e1)
			  nCl <- class2(class(M), 'l') # logical Tsparse
			  r <- new(nCl)
			  r@x <- callGeneric(M@x, e2)
			  ## copy "the other slots" (important for "tr"/"sym"):
			  ## "%w/o%" <- function(x,y) x[is.na(match(x, y))]
			  sN <- slotNames(nCl)
			  for(n in sN[is.na(match(sN, "x"))])
			      slot(r, n) <- slot(M, n)
			  if(extends(cl1, "CsparseMatrix"))
			      r <- as(r, "CsparseMatrix")
			  else if(extends(cl1, "RsparseMatrix"))
			      r <- as(r, "RsparseMatrix")
		      }
		  } else {
		      ## non sparse result
		      if(getOption("verbose"))
			  message(sprintf("sparse to dense (%s) coercion in '%s'",
					  lClass, .Generic))
		      rx <- rep.int(r0, d[1]*d[2])
		      rx[1:1 + encodeInd(non0ind(e1), nr = d[1])] <- r
		      r <- new(fullCl, x = rx, Dim = d, Dimnames = dimnames(e1))
		  }
	      }
	      r
	  })

## "dMatrix <-> work with 'x' slot {was originally just for "Compare":
##  ------- this is *not* used for 'Arith" which
setMethod("Ops", signature(e1 = "dMatrix", e2 = "dMatrix"),
	  function(e1, e2) {
	      d <- dimCheck(e1,e2)
	      if((dens1 <- is(e1, "denseMatrix"))) gen1 <- is(e1, "generalMatrix")
	      if((dens2 <- is(e2, "denseMatrix"))) gen2 <- is(e2, "generalMatrix")

	      if(dens1 && dens2) { ## both inherit from ddense*

		  if(!gen1) e1 <- as(e1, "dgeMatrix")
		  if(!gen2) e2 <- as(e2, "dgeMatrix")
		  ## now, both are dge {ddense* & general*}

		  r <- callGeneric(e1@x, e2@x)
		  r <- new(paste(.M.kind(r), "geMatrix", sep=''),
			   x = r, Dim = d, Dimnames = dimnames(e1))
	      }
	      else {
		  if(!dens1 && !dens2) {
		      ## both e1 _and_ e2 are sparse
		      ## should not happen since we have <sparse> o <sparse> methods
		      stop("Mistaken intended method dispatch -- please report to ",
			   packageDescription("Matrix")$Author)
		  }
		  ## else
		  if(dens1 && !dens2) ## go to dense
		      r <- callGeneric(e1, as(e2, "denseMatrix"))
		  else ## if(!dens1 && dens2)
		      r <- callGeneric(as(e1, "denseMatrix"), e2)

		  ## criterion "2 * nnz(.) < ." as in sparseDefault() in Matrix()  [./Matrix.R] :
		  if(2 * nnzero(r, na.counted = TRUE) < prod(d))
		      r <- as(r, "sparseMatrix")
	      }
	      r
	  })

### --  I -- dense -----------------------------------------------------------

##-------- originally from ./dgeMatrix.R --------------------

## ----- only work with NAMESPACE importFrom(methods, ..)

setMethod("Arith", signature(e1 = "dgeMatrix", e2 = "dgeMatrix"),
          ##  "+", "-", "*", "^", "%%", "%/%", "/"
	  function(e1, e2) {
	      ## NB:  triangular, symmetric, etc may need own method
	      d1 <- e1@Dim
	      d2 <- e2@Dim
	      eqD <- d1 == d2
	      if (!eqD[1])
		  stop("Matrices must have same number of rows for arithmetic")
	      same.dim <- eqD[2]
	      if (same.dim) {
		  d <- d1
		  dn <- dimNamesCheck(e1, e2)
	      }
	      else { # nrows differ ----> maybe recycling
		  if(d2[2] %% d1[2] == 0) { # nrow(e2) is a multiple
		      e1@x <- rep.int(e1@x, d2[2] %/% d1[2])
		      d <- d2
		      dn <- e2@Dimnames
		  } else if(d1[2] %% d2[2] == 0) { # nrow(e1) is a multiple
		      e2@x <- rep.int(e2@x, d1[2] %/% d2[2])
		      d <- d1
		      dn <- e1@Dimnames
		  } else
		      stop("number of rows are not compatible for ", .Generic)
	      }

	      ## be smart and preserve, e.g., triangular, or symmetric
	      ## but this sucks: For these,
	      ## 'uplo' and 'diag' also must coincide or be dealt with properly

	      ## ==> triangular, symmetric, etc may need own method
	      ##     also since their @x is `non-typical'

##		 if(same.dim) {
##		     if(extends(class(e1), class(e2))) {
##			 e2@x <- callGeneric(e1@x, e2@x)
##			 e2@Dimnames <- dn
##			 e2
##		     }
##		     else if(extends(class(e2), class(e1))) {
##			 e1@x <- callGeneric(e1@x, e2@x)
##			 e1@Dimnames <- dn
##			 e1
##		     }
##		 }
##		 else
		  new("dgeMatrix", Dim = d, Dimnames = dn,
		      x = callGeneric(e1@x, e2@x))
	  })

setMethod("Arith", signature(e1 = "dgeMatrix", e2 = "numeric"),
	  function(e1, e2) {
	      d <- e1@Dim
	      le <- length(e2)
	      if(le == 1 || le == d[1] || prod(d) == le) { # matching dim
		  e1@x <- callGeneric(e1@x, as.vector(e2))
		  e1
	      } else stop ("length of 2nd arg does not match dimension of first")
	  })

setMethod("Arith", signature(e1 = "numeric", e2 = "dgeMatrix"),
	  function(e1, e2) {
	      d <- e2@Dim
	      le <- length(e1)
	      if(le == 1 || le == d[1] || prod(d) == le) { # matching dim
		  e2@x <- callGeneric(as.vector(e1), e2@x)
		  e2
	      } else stop ("length of 1st arg does not match dimension of 2nd")
	  })

##-------- originally from ./ddenseMatrix.R --------------------

## Cheap version: work via "dgeMatrix" and use the group methods there:
## FIXME(?): try to preserve "symmetric", "triangular", ...
setMethod("Arith", signature(e1 = "ddenseMatrix", e2 = "ddenseMatrix"),
          function(e1, e2) callGeneric(as(e1, "dgeMatrix"),
                                       as(e2, "dgeMatrix")))
setMethod("Arith", signature(e1 = "ddenseMatrix", e2 = "numeric"),
          function(e1, e2) callGeneric(as(e1, "dgeMatrix"), e2))
setMethod("Arith", signature(e1 = "numeric", e2 = "ddenseMatrix"),
          function(e1, e2) callGeneric(e1, as(e2, "dgeMatrix")))

## "Logic"
## -------

##-------- originally from ./ldenseMatrix.R --------------------

## These all had "Logic", but now are for all "Ops":

setMethod("Ops", signature(e1="lgeMatrix", e2="lgeMatrix"), .Ops.via.x)

setMethod("Ops", signature(e1="ngeMatrix", e2="ngeMatrix"), .Ops.via.x)

setMethod("Ops", signature(e1="ldenseMatrix", e2="ldenseMatrix"),
	  function(e1,e2) {
	      d <- dimCheck(e1, e2)
	      callGeneric(as(e1, "lgeMatrix"), as(e2, "lgeMatrix"))
	  })

setMethod("Ops", signature(e1="ndenseMatrix", e2="ndenseMatrix"),
	  function(e1,e2) {
	      d <- dimCheck(e1, e2)
	      callGeneric(as(e1, "ngeMatrix"), as(e2, "ngeMatrix"))
	  })


setMethod("Logic", signature(e1 = "logical", e2 = "Matrix"),
          function(e1, e2) callGeneric(e1, as(e2, "lMatrix")))
setMethod("Logic", signature(e1 = "Matrix", e2 = "logical"),
          function(e1, e2) callGeneric(as(e1, "lMatrix"), e2))

### "ANY" here means "any non-Matrix" (since "Ops"(ANY) has already bailout above):
setMethod("Logic", signature(e1 = "ANY", e2 = "Matrix"),
          function(e1, e2) callGeneric(as.logical(e1), as(e2, "lMatrix")))
setMethod("Logic", signature(e1 = "Matrix", e2 = "ANY"),
          function(e1, e2) callGeneric(as(e1, "lMatrix"), as.logical(e2)))

setMethod("Logic", signature(e1 = "logical", e2 = "lMatrix"),
          ## "swap RHS and LHS" and use the method below:
	  function(e1,e2) callGeneric(e2, e1))

## This is modelled after the "Compare" ("dMatrix", "numeric") above
setMethod("Logic", signature(e1 = "lMatrix", e2 = "logical"),
	  function(e1, e2) { ## result will typically be "like" e1:
	      r	 <- callGeneric(e1@x, e2)
	      r0 <- callGeneric(FALSE, e2)
	      d <- e1@Dim
	      ## trivial case first (beware of NA)
	      if(isTRUE(r0 && all(r))) {
		  r <- new(if(d[1] == d[2]) "lsyMatrix" else "lgeMatrix")
		  r@Dim <- d
		  r@Dimnames <- e1@Dimnames
		  r@x <- rep.int(TRUE, prod(d))
	      }
	      else if(extends(cl1 <- getClassDef(cl <- class(e1)),
			      "denseMatrix")) {
		  full <- !isPacked(e1) # << both "dtr" and "dsy" are 'full'
		  if(full || identical(r0, FALSE) || extends(cl1,"symmetricMatrix"))
		      r <- new(cl, x = r, Dim = d, Dimnames = dimnames(e1))
		  else { ## packed matrix with structural 0 and r0 is not FALSE:
		      ##--> result cannot be packed anymore
		      ## [dense & packed & not symmetric ] ==> must be "ltp*" :
		      if(!extends(cl1, "ltpMatrix"))
			  stop("internal bug in \"Logic\" method for \"lMatrix\"; please report")
		      rx <- rep.int(r0, d[1]*d[2])
		      rx[indTri(d[1], upper = (e1@uplo == "U"))] <- r
		      r <- new("lgeMatrix", x = rx,
			       Dim = d, Dimnames = dimnames(e1))
		  }

	      }
	      else { ## lsparseMatrix

		  if(identical(r0, FALSE)) { ## things remain sparse
		      if(!any(is.na(r)) && ((Ar <- all(r)) || !any(r))) {
			  r <- new(cl)
			  r@Dim <- d
			  r@Dimnames <- dimnames(e1)
			  if(Ar) { # 'TRUE' instead of 'x': same sparsity:
			      r@x <- rep.int(TRUE, length(e1@x))
			      for(n in intersect(c("i","j","p"), slotNames(r)))
				  slot(r, n) <- slot(e1, n)
			  }
			  else { ## all FALSE: keep empty 'r' matrix
			      ## but may need a valid 'pointer' slot:
			      if(extends(cl, "CsparseMatrix"))
				  r@p <- rep.int(0:0, 1+ncol(r))
			      else if(extends(cl, "RsparseMatrix"))
				  r@p <- rep.int(0:0, 1+nrow(r))
			  }
		      } else { # some TRUE, FALSE, NA : go via unique 'Tsparse'
			  M <- asTuniq(e1)
			  nCl <- class(M) # logical Tsparse
			  r <- new(nCl)
			  r@x <- callGeneric(M@x, e2)
			  ## copy "the other slots" (important for "tr"/"sym"):
			  ## "%w/o%" <- function(x,y) x[is.na(match(x, y))]
			  sN <- slotNames(nCl)
			  for(n in sN[is.na(match(sN, "x"))])
			      slot(r, n) <- slot(M, n)
			  if(extends(cl1, "CsparseMatrix"))
			      r <- as(r, "CsparseMatrix")
			  else if(extends(cl1, "RsparseMatrix"))
			      r <- as(r, "RsparseMatrix")
		      }
		  } else {
		      ## non sparse result
		      if(getOption("verbose"))
			  message(sprintf("sparse to dense (%s) coercion in '%s'",
					  cl, .Generic))
		      rx <- rep.int(r0, d[1]*d[2])
		      if(extends(cl1, "triangularMatrix") && e1@diag == "U")
			  r <- c(r, rep.int(callGeneric(1, e2),d[1]))
		      rx[1:1 + encodeInd(non0ind(e1), nr = d[1])] <- r
		      fullCl <-
			  if(extends(cl1, "symmetricMatrix")) "lsyMatrix" else "lgeMatrix"
		      r <- new(fullCl, x = rx, Dim = d, Dimnames = dimnames(e1))
		  }
	      }
	      r
	  })


### -- II -- sparse ----------------------------------------------------------

## Have lgC o lgC  and then lgT o lgT  Logic - quite similarly -

## Here's the common functionality
.do.Logic.lsparse <- function(e1,e2, d, dn, isOR, ij1, ij2) {
    ii <- WhichintersectInd(ij1, ij2, nrow=d[1])
    I1 <- ii[[1]]
    I2 <- ii[[2]]

    ## 1) common indices
    i <- ij1[I1, 1]
    j <- ij1[I1, 2]

    if(isOR) { ## i.e. .Generic == "|" i.e. not "&"
        x <- e1@x[I1] | e2@x[I2]
        ## 2) "e1 o  FALSE":
        x2 <- e1@x[- I1] # == callGeneric(e1@x[- I1], FALSE)
        ## 3) "0  o e1":
        x3 <- e2@x[- I2] # == callGeneric(FALSE, e2@x[- I2])
        i <- c(i, ij1[-I1, 1], ij2[-I2, 1])
        j <- c(j, ij1[-I1, 2], ij2[-I2, 2])
        x <- c(x, x2,		 x3)
    } else { ## AND
        x <- e1@x[I1] & e2@x[I2]
    }

    if(any(!x)) { ## drop 'FALSE's
        i <- i[x]
        j <- j[x]
        x <- x[x]
    }
    new("lgTMatrix", Dim = d, Dimnames = dn, i = i, j = j, x = x)
}

setMethod("Logic", signature(e1="lgCMatrix", e2="lgCMatrix"),
	  function(e1, e2) {
	      d <- dimCheck(e1, e2)
	      dn <- dimNamesCheck(e1, e2)
	      ## Very easy case first :
	      if(identical(e1@i, e2@i) && identical(e1@p, e2@p)) {
		  e1@x <- callGeneric(e1@x, e2@x)
		  return(e1)
	      }
	      ## else :

	      .Call(Tsparse_to_Csparse,
		    .do.Logic.lsparse(e1, e2, d = d, dn = dn,
				      isOR = .Generic == "|",
				      ij1 = .Call(compressed_non_0_ij, e1, TRUE),
				      ij2 = .Call(compressed_non_0_ij, e2, TRUE)),
		    FALSE)
	  })

setMethod("Logic", signature(e1="lgTMatrix", e2="lgTMatrix"),
	  function(e1,e2) {
	      d <- dimCheck(e1, e2)
	      dn <- dimNamesCheck(e1, e2)
	      ## Very easy case first :
	      if(identical(e1@i, e2@i) && identical(e1@j, e2@j)) {
		  e1@x <- callGeneric(e1@x, e2@x)
		  return(e1)
	      }
	      ## else :
	      cld <- getClassDef("lgTMatrix")
	      .do.Logic.lsparse(e1, e2, d = d, dn = dn,
				isOR = .Generic == "|",
				ij1 = non0ind(e1, cld),
				ij2 = non0ind(e2, cld))
          })

## Now the other "Ops" for the "lgT" and "lgC" cases:
setMethod("Arith", signature(e1="lgCMatrix", e2="lgCMatrix"),
	  function(e1, e2) callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix")))
setMethod("Arith", signature(e1="lgTMatrix", e2="lgTMatrix"),
	  function(e1, e2) callGeneric(as(e1, "dgTMatrix"), as(e2, "dgTMatrix")))

## FIXME: These are really too cheap: currently almost all go via dgC*() :
## setMethod("Compare", signature(e1="lgCMatrix", e2="lgCMatrix"),
## setMethod("Compare", signature(e1="lgTMatrix", e2="lgTMatrix"),
## setMethod("Compare", signature(e1="lsparseMatrix", e2="lsparseMatrix"),
## 	  function(e1, e2) callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix")))
setMethod("Compare", signature(e1="lsparseMatrix", e2="lsparseMatrix"),
	  function(e1, e2) callGeneric(as(e1, "CsparseMatrix"),
				       as(e2, "CsparseMatrix")))

## setMethod("Compare", signature(e1="lgTMatrix", e2="lgTMatrix"), ## coerce to Csparse

## 	  function(e1, e2) callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix")))


##--- Sparse ... ----------

.Ops.lsparse <- function(e1, e2) {
    ## of course, this is still suboptimal, e.g. if both are "lsT" or "lsC"
    if(is(e1, "TsparseMatrix"))
        callGeneric(as(e1, "lgTMatrix"), as(e2, "lgTMatrix"))
    else
	callGeneric(as(e1, "lgCMatrix"), as(e2, "lgCMatrix"))
}

setMethod("Ops", signature(e1="lsparseMatrix", e2="lsparseMatrix"),
	  .Ops.lsparse)

setMethod("Logic", signature(e1="lsparseMatrix", e2="ldenseMatrix"),
	  .Ops.lsparse)

setMethod("Logic", signature(e1="ldenseMatrix", e2="lsparseMatrix"),
	  function(e1, e2) {
	      if(is(e2, "TsparseMatrix"))
		  callGeneric(as(e1, "lgTMatrix"), as(e2, "lgTMatrix"))
	      else
		  callGeneric(as(e1, "lgCMatrix"), as(e2, "lgCMatrix"))
	  })



## FIXME: also want (symmetric o symmetric) , (triangular o triangular)
## -----
setMethod("Arith", signature(e1 = "dsCMatrix", e2 = "dsCMatrix"),
	  function(e1, e2) {
	      message("suboptimal implementation of 'symm. o symm.'")
	      as(callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix")),
		 "dsCMatrix")
	  })

setMethod("Arith", signature(e1 = "dtCMatrix", e2 = "dtCMatrix"),
	  function(e1, e2) {
	      U1 <- e1@uplo
	      isTri <- U1 == e2@uplo
	      if(isTri)
		  message("suboptimal implementation of 'triang.  o  triang.'")
              ## else:   lowerTri  o  upperTri: |--> "all 0" {often} -- FIXME?
	      r <- callGeneric(as(e1, "dgCMatrix"), as(e2, "dgCMatrix"))
	      if(isTri) as(r, "dtCMatrix") else r
	  })



##-------- originally from ./dgCMatrix.R --------------------

setMethod("Arith", signature(e1 = "dgCMatrix", e2 = "dgCMatrix"),
          ##  "+", "-", "*", "^", "%%", "%/%", "/"
	  function(e1, e2) {
	      d <- dimCheck(e1, e2)
	      dn <- dimNamesCheck(e1, e2)
	      ij1 <- non0ind(e1)
	      ij2 <- non0ind(e2)
	      switch(.Generic,
		     "+" = , "-" =
		     ## special "T" convention: repeated entries are *summed*
		     .Call(Tsparse_to_Csparse,
			   new("dgTMatrix", Dim = d, Dimnames = dn,
			       i = c(ij1[,1], ij2[,1]),
			       j = c(ij1[,2], ij2[,2]),
			       x = c(callGeneric(e1@x, 0),callGeneric(0,e2@x))),
			   FALSE),

		     "*" =
		 { ##  X * 0 == 0 * X == 0 --> keep common non-0
		     ii <- WhichintersectInd(ij1, ij2, nrow=d[1])
		     ij <- ij1[ii[[1]], , drop = FALSE]
		     .Call(Tsparse_to_Csparse,
			   new("dgTMatrix", Dim = d, Dimnames = dn,
			       i = ij[,1],
			       j = ij[,2],
			       x = e1@x[ii[[1]]] * e2@x[ii[[2]]]),
			   FALSE)
		 },

		     "^" =
		 {
		     ii <- WhichintersectInd(ij1, ij2, nrow=d[1])
		     ## 3 cases:
		     ## 1) X^0 := 1  (even for X=0) ==> dense
		     ## 2) 0^Y := 0  for Y != 0		=====
		     ## 3) x^y :

		     ## FIXME:	dgeM[cbind(i,j)] <- V  is not yet possible
		     ##	    nor dgeM[ i_vect   ] <- V
		     ## r <- as(e2, "dgeMatrix")
		     ## ...
		     r <- as(e2, "matrix")
		     Yis0 <- is0(r)
		     r[complementInd(ij1, dim=d)] <- 0 ## 2)
		     r[1:1 + ij2[ii[[2]], , drop=FALSE]] <-
			 e1@x[ii[[1]]] ^ e2@x[ii[[2]]]	    ## 3)
		     r[Yis0] <- 1			    ## 1)
		     as(r, "dgeMatrix")
		 },

		     "%%" = , "%/%" = , "/" = ## 0 op 0	 |-> NaN => dense
		     callGeneric(as(e1, "dgeMatrix"), e2)
		     )
	  })

setMethod("Arith", signature(e1 = "dgCMatrix", e2 = "numeric"),
	  function(e1, e2) {
	      if((l2 <- length(e2)) == 0)
		  stop("<Matrix>",.Generic,"numeric(0) is undefined")
	      f0 <- callGeneric(0, e2)
	      if(all(is0(f0))) { # remain sparse
		  if(l2 > 1) { # length(e2) > 1 : "recycle" e2 "carefully"
		      n <- prod(d <- dim(e1))
		      if(n < l2)
			  stop("<Matrix>",.Generic,"numeric(<too-long>)")
		      if(n %% l2 != 0) ## identical warning as in main/arithmetic.c
			  warning(gettextf("longer object length\n\tis not a multiple of shorter object length"))
		      ## TODO: construction of [1:1 + in0 %%l2] via one .Call()
		      ## 0-based indices:
		      in0 <- encodeInd(.Call(compressed_non_0_ij, e1, TRUE), d[1])
		      e2 <- e2[1:1 + in0 %% l2]
		  }
		  e1@x <- callGeneric(e1@x, e2)
		  e1
	      }
	      else { ## non-sparse, since '0 o e2' is not (all) 0
		  r <- as(e1, "matrix")
		  if(length(e2) == 1) {
		      r[] <- f0
		      r[non0ind(e1) + 1:1] <- callGeneric(e1@x, e2)
		      as(r, "dgeMatrix")
		  } else {
		      as(callGeneric(r, e2), "dgeMatrix")
		  }
	      }})


setMethod("Arith", signature(e1 = "numeric", e2 = "dgCMatrix"),
	  function(e1, e2) {
	      if((l1 <- length(e1)) == 0)
		  stop("numeric(0)",.Generic,"<Matrix> is undefined")
	      f0 <- callGeneric(e1, 0)
	      if(all(is0(f0))) { # remain sparse
		  if(l1 > 1) { # length(e1) > 1 : "recycle" e1 "carefully"
		      n <- prod(d <- dim(e2))
		      if(n < l1)
			  stop("numeric(<too-long>)",.Generic,"<Matrix>")
		      if(n %% l1 != 0) ## identical warning as in main/arithmetic.c
			  warning(gettextf("longer object length\n\tis not a multiple of shorter object length"))
		      ## TODO: construction of [1:1 + in0 %% l1] via one .Call()
		      ## 0-based indices:
		      in0 <- encodeInd(.Call(compressed_non_0_ij, e2, TRUE), d[1])
		      e1 <- e1[1:1 + in0 %% l1]
		  }
		  e2@x <- callGeneric(e1, e2@x)
		  e2
	      }
	      else { ## non-sparse, since '0 o e2' is not (all) 0
		  r <- as(e2, "matrix")
		  if(length(e1) == 1) {
		      r[] <- f0
		      r[non0ind(e2) + 1:1] <- callGeneric(e1, e2@x)
		      as(r, "dgeMatrix")
		  } else {
		      as(callGeneric(e1, r), "dgeMatrix")
		  }
	      }})

##-------- originally from ./Csparse.R --------------------
## TODO : Consider going a level up, and do this for all "Ops"

setMethod("Arith", signature(e1 = "CsparseMatrix", e2 = "CsparseMatrix"),
	  function(e1, e2) {
	      ## go via "symmetric" if both are symmetric, etc...
	      s1 <- .M.shape(e1, c1 <- getClassDef(class(e1)))
	      s2 <- .M.shape(e2, c2 <- getClassDef(class(e2)))
	      viaCl <- paste("d", if(s1 == s2) s1 else "g", "CMatrix", sep='')
	      callGeneric(as(as(e1, "dMatrix"), viaCl),
			  as(as(e2, "dMatrix"), viaCl))
          })

setMethod("Arith", signature(e1 = "CsparseMatrix", e2 = "numeric"),
	  function(e1, e2) {
	      if(length(e2) == 1) { ## e.g.,  Mat ^ a
		  f0 <- callGeneric(0, e2)
		  if(is0(f0)) { # remain sparse, symm., tri.,...
                      e1 <- as(e1, "dMatrix")
		      e1@x <- callGeneric(e1@x, e2)
		      return(e1)
		  }
	      }
	      ## all other (potentially non-sparse) cases: give up symm, tri,..
	      callGeneric(as(e1, paste(.M.kind(e1), "gCMatrix", sep='')), e2)
	  })

## The same,  e1 <-> e2 :
setMethod("Arith", signature(e1 = "numeric", e2 = "CsparseMatrix"),
	  function(e1, e2) {
	      if(length(e1) == 1) {
		  f0 <- callGeneric(e1, 0)
		  if(is0(f0)) {
                      e2 <- as(e2, "dMatrix")
		      e2@x <- callGeneric(e1, e2@x)
		      return(e2)
		  }
	      }
	      callGeneric(e1, as(e2, paste(.M.kind(e2), "gCMatrix", sep='')))
	  })

setMethod("Compare", signature(e1 = "CsparseMatrix", e2 = "CsparseMatrix"),
	  function(e1, e2) {
	      d <- dimCheck(e1,e2)

	      ## How do the "0" or "FALSE" entries compare?
	      ## Depends if we have an "EQuality RELation" or not:
	      EQrel <- switch(.Generic,
			      "==" =, "<=" =, ">=" = TRUE,
			      "!=" =, "<"  =, ">"  = FALSE)
	      if(EQrel) {
		  ## The (0 op 0) or  (FALSE op FALSE) comparison gives TRUE
		  ## -> result becomes *dense*; the following may be suboptimal
		  return( callGeneric(as(e1, "denseMatrix"),
				      as(e2, "denseMatrix")))
	      }

	      ## else: INequality:   0 op 0 gives FALSE ---> remain sparse!

              cD1 <- getClassDef(class(e1))
              cD2 <- getClassDef(class(e2))

	      ## NB non-diagonalMatrix := Union{ general, symmetric, triangular}
	      gen1 <- extends(cD1, "generalMatrix")
	      gen2 <- extends(cD2, "generalMatrix")
	      sym1 <- !gen1 && extends(cD1, "symmetricMatrix")
	      sym2 <- !gen2 && extends(cD2, "symmetricMatrix")
	      tri1 <- !gen1 && !sym1
	      tri2 <- !gen2 && !sym2
	      G <- gen1 && gen2
	      S <- sym1 && sym2 && e1@uplo == e2@uplo
	      T <- tri1 && tri2 && e1@uplo == e2@uplo

	      if(T && e1@diag != e2@diag) {
		  ## one is "U" the other "N"
		  if(e1@diag == "U")
		      e1 <- diagU2N(e1)
		  else ## (e2@diag == "U"
		      e2 <- diagU2N(e2)
	      }
	      else if(!G && !S && !T) {
                  ## e.g. one symmetric, one general
                  ## coerce to generalMatrix and go :
		  if(!gen1) e1 <- as(e1, "generalMatrix", strict = FALSE)
		  if(!gen2) e2 <- as(e2, "generalMatrix", strict = FALSE)
	      }

	      dn <- dimNamesCheck(e1, e2)
              ## the result object:
	      newC <- sub("^.", "l", class(e1))
	      r <- new(newC)

              ## Very easy case:
              if(identical(e1@i, e2@i) && identical(e1@p, e2@p)) {
		  if(extends(cD2, "nMatrix")) {
		      ## non-equality of identical pattern matrices: all FALSE
		  } else { # have 'x' slot
		      r@x <- callGeneric(e1@x, e2@x)
		      ## and all others are  '0 op 0' which give FALSE
		      r@i <- e1@i
		      r@p <- e1@p
		  }
		  r@Dim <- d
		  r@Dimnames <- dn
		  r
              }
              else {
                  ## now the 'x' slots ``match'' insofar as they are for the
                  ## same "space" (triangle for tri* and symm*; else rectangle)

                  ## not non0ind() which gives more;
                  ## want only those which correspond to 'x' slot
                  ij1 <- .Call(compressed_non_0_ij, e1, TRUE)
                  ij2 <- .Call(compressed_non_0_ij, e2, TRUE)
                  ii <- WhichintersectInd(ij1, ij2, nrow=d[1])
                  I1 <- ii[[1]]
                  I2 <- ii[[2]]

                  ## 1) common
                  x <- callGeneric(e1@x[I1],
                                   e2@x[I2])
                  ## 2) "e1 o  0":
                  x2 <- callGeneric(e1@x[- I1], 0)
                  ## 3) "0  o e1":
                  x3 <- callGeneric(0, e2@x[- I2])

		  i <- c(ij1[I1, 1], ij1[-I1, 1], ij2[-I2, 1])
		  j <- c(ij1[I1, 2], ij1[-I1, 2], ij2[-I2, 2])
		  x <- c( x,	    x2,		 x3)
		  if(any(!x)) { # drop 'FALSE's
		      i <- i[x]
		      j <- j[x]
		      x <- x[x]
		  }
		  as(new("lgTMatrix", Dim = d, Dimnames = dn,
			 i = i, j = j, x = x),
		     "lgCMatrix")
              }
	  })


##-------- originally from ./sparseMatrix.R --------------------

## "Arith" short cuts / exceptions
setMethod("-", signature(e1 = "sparseMatrix", e2 = "missing"),
          function(e1) { e1@x <- -e1@x ; e1 })
## with the following exceptions:
setMethod("-", signature(e1 = "nsparseMatrix", e2 = "missing"),
          function(e1) callGeneric(as(as(e1, "dMatrix"), "dgCMatrix")))
setMethod("-", signature(e1 = "pMatrix", e2 = "missing"),
          function(e1) callGeneric(as(e1, "ngTMatrix")))

## Group method  "Arith"

## have CsparseMatrix methods above
## which may preserve "symmetric", "triangular" -- simply defer to those:

## these where 'Arith', now generalized:
setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"),
	  function(e1, e2) callGeneric(as(e1, "CsparseMatrix"),
				       as(e2, "CsparseMatrix")))
setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "numeric"),
	  function(e1, e2) callGeneric(as(e1, "CsparseMatrix"), e2))
setMethod("Ops", signature(e1 = "numeric", e2 = "sparseMatrix"),
	  function(e1, e2) callGeneric(e1, as(e2, "CsparseMatrix")))

## setMethod("Compare", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"),
## 	  function(e1, e2) callGeneric(as(e1, "CsparseMatrix"),
## 				       as(e2, "CsparseMatrix")))

###-------- sparseVector -------------
###-------- ============ -------------

## Catch all ( ==> better error message than default):
setMethod("Ops", signature(e1 = "sparseVector", e2 = "ANY"),
          function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2)))
setMethod("Ops", signature(e1 = "ANY", e2 = "sparseVector"),
          function(e1, e2) .bail.out.2(.Generic, class(e1), class(e2)))

## 1)  spVec  o  (sp)Vec : -------------

## FIXME:
##   1. <spVec>  o  <scalar>   should  *NOT* go via  <spV> o <spV>
##   2. <spVec>  o  <non-NA numeric>  should also happen directly and
##                                    |-> sparse for o = {'*', "/", '&&'

setMethod("Ops", signature(e1 = "sparseVector", e2 = "atomicVector"),
	  function(e1, e2) callGeneric(e1, as(e2, "sparseVector")))
setMethod("Ops", signature(e1 = "atomicVector", e2 = "sparseVector"),
	  function(e1, e2) callGeneric(as(e1, "sparseVector"), e2))

setMethod("Arith", signature(e1 = "sparseVector", e2 = "sparseVector"),
          function(e1, e2) callGeneric(as(e1, "dsparseVector"),
                                       as(e2, "dsparseVector")))
setMethod("Logic", signature(e1 = "sparseVector", e2 = "sparseVector"),
          function(e1, e2) callGeneric(as(e1, "lsparseVector"),
                                       as(e2, "lsparseVector")))

setMethod("Arith", signature(e1 = "dsparseVector", e2 = "dsparseVector"),

          ##  "+", "-", "*", "^", "%%", "%/%", "/"

          function(e1, e2) {
              n1 <- e1@length
              n2 <- e2@length
              if(n1 != n2) {
                  if(n1 < n2) {
                      n <- n1 ; N <- n2
                  } else {
                      n <- n2 ; N <- n1
                  }
                  if(N %% n != 0) ## require this here, for conveniense
                      ## for regular vectors, this is only a warning:
                      stop("longer object length\n\t",
                              "is not a multiple of shorter object length")
                  if(n == 1) { # simple case, do not really recycle
                      if(n1 < n2) return(callGeneric(sp2vec(e1, "double"), e2))
                      else        return(callGeneric(e1, sp2vec(e2, "double")))
                  }
                  ## else : 2 <= n < N --- recycle the shorter one
                  q <- N %/% n
                  if(n1 < n2) {
                      e1@i <- rep.int(e1@i, q)
                      e1@x <- rep.int(e1@x, q)
                  } else {
                      e2@i <- rep.int(e2@i, q)
                      e2@x <- rep.int(e2@x, q)
                  }
              } else { ## n1 == n2
                  N <- n1
              }
              r <- new("dsparseVector", length = N)
	      switch(.Generic,
		     "+" = , "-" =  ## X +- 0 == 0 +- X == X

		     ii <- union(e1@i, e2@i),

		     "*" =
		 { ##  X * 0 == 0 * X == 0 --> keep common non-0
		     ii <- intersect(e1@i, e2@i)

		 },

		     "^" =
		 {

		     ii <- intersect(e1@i, e2@i)
		     ## 3 cases:
		     ## 1) X^0 := 1  (even for X=0) ==> dense
		     ## 2) 0^Y := 0  for Y != 0		=====
		     ## 3) x^y :

		     ## FIXME:	dgeM[cbind(i,j)] <- V  is not yet possible
		     ##	    nor dgeM[ i_vect   ] <- V
		     ## r <- as(e2, "dgeMatrix")
		     ## ...
		 },

		     "%%" = , "%/%" = , "/" = ## 0 op 0	 |-> NaN => dense

		     )

              .bail.out.2(.Generic, class(e1), class(e2))
          })

## "Arith"  exception (shortcut)
setMethod("-", signature(e1 = "dsparseVector", e2 = "missing"),
          function(e1) { e1@x <- -e1@x ; e1 })


setMethod("Logic", signature(e1 = "lsparseVector", e2 = "lsparseVector"),
          function(e1, e2) {
              .bail.out.2(.Generic, class(e1), class(e2))
          })

## 2)  spVec  o  [Mm]atrix : -------------