R/solve.R

setMethod("solve", signature(a = "ANY", b = "ANY"), function(a,b, 
             generalized = getdistrOption("use.generalized.inverse.by.default"),
             tol = .Machine$double.eps, ...) {
          if(!generalized|is.null(dim(a))) return(base::solve(a,b, tol = tol, ...))
          else if(nrow(a)==ncol(a)){
             abtry <- try({
                 ab <- base::solve(a,b, tol = tol, ...)
                 if(missing(b)){
                    dimnames(ab) <-  rev(dimnames(a))
                 }else{
                    names(ab) <-  colnames(a)
                 }
                 return(ab)
             }, silent = TRUE)
             if(!is(abtry, "try-error")) return(abtry)
          }
          if (!missing(b))
              if(!(length(b)==nrow(a))) stop("non-conformable arguments")
          a.m <- MASS::ginv(a)
          dimnames(a.m) <- rev(dimnames(a))
          if (missing(b)) return(a.m)
              else return(a.m %*% b)
          })

setMethod("solve", signature(a = "PosSemDefSymmMatrix", b = "ANY"), 
           function(a,b, 
               generalized = getdistrOption("use.generalized.inverse.by.default"), 
               tol = .Machine$double.eps, ...){
          if(!generalized) return(base::solve(a,b, tol = tol, ...))
          else{
            er <- eigen(a)
            d1 <- er$values
            d <- 1/d1[d1 > tol]
            ev <- er$vectors[,d1 > tol]
            A <- if (length(d)) ev %*% (t(ev)*d) else 0*a
            dimnames(A) <- dimnames(a)
            if(missing(b)) return(A)
            else return(A%*%b)}   
})

setMethod("solve", signature(a = "PosDefSymmMatrix", b = "ANY"), function(a,b, ...){
base::solve(a,b, ...)})

Try the distr package in your browser

Any scripts or data that you put into this service are public.

distr documentation built on May 31, 2023, 5:58 p.m.