| # File src/library/base/R/solve.R |
| # Part of the R package, https://www.R-project.org |
| # |
| # Copyright (C) 1995-2016 The R 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. |
| # |
| # A copy of the GNU General Public License is available at |
| # https://www.R-project.org/Licenses/ |
| |
| solve.qr <- function(a, b, ...) |
| { |
| if(!inherits(a, "qr")) |
| stop("this is the \"qr\" method for the generic function solve()") |
| nc <- ncol(a$qr); nr <- nrow(a$qr) |
| if( a$rank != min(nc, nr) ) |
| stop("singular matrix 'a' in 'solve'") |
| if( missing(b) ) { |
| if( nc != nr ) |
| stop("only square matrices can be inverted") |
| b <- diag(1, nc) |
| } |
| res <- qr.coef(a, b) |
| res[is.na(res)] <- 0 |
| res |
| } |
| |
| solve.default <- |
| function(a, b, tol = .Machine$double.eps, LINPACK = FALSE, ...) |
| { |
| if(is.complex(a) || (!missing(b) && is.complex(b))) { |
| a <- as.matrix(a) |
| if(missing(b)) { |
| b <- diag(1.0+0.0i, nrow(a)) |
| colnames(b) <- rownames(a) |
| } |
| return(.Internal(La_solve_cmplx(a, b))) |
| } |
| |
| if(inherits(a, "qr")) { |
| warning("solve.default called with a \"qr\" object: use 'qr.solve'") |
| return(solve.qr(a, b, tol)) |
| } |
| |
| a <- as.matrix(a) |
| if(missing(b)) { |
| b <- diag(1.0, nrow(a)) |
| colnames(b) <- rownames(a) |
| } |
| .Internal(La_solve(a, b, tol)) |
| } |
| |
| solve <- function(a, b, ...) UseMethod("solve") |
| |
| qr.solve <- function(a, b, tol = 1e-7) |
| { |
| if(!inherits(a, "qr")) |
| a <- qr(a, tol = tol) |
| nc <- ncol(a$qr); nr <- nrow(a$qr) |
| if( a$rank != min(nc, nr) ) |
| stop("singular matrix 'a' in solve") |
| if( missing(b) ) { |
| if( nc != nr ) |
| stop("only square matrices can be inverted") |
| b <- diag(1, nc) |
| } |
| res <- qr.coef(a, b) |
| res[is.na(res)] <- 0 |
| res |
| } |
| |