Rlinsolve/0000755000176200001440000000000015064155140012230 5ustar liggesusersRlinsolve/MD50000644000176200001440000000462615064155140012550 0ustar liggesusersa9cd16faa8857dbbed0d3da390c61dd1 *DESCRIPTION ce29a8a7f56b9241c73f75cffc335688 *LICENSE e942b3185571401e268bcaf4ea119b1d *NAMESPACE 094baef125212d12d06cf03dbe390336 *NEWS.md 953f1e642fe00ea59bdd78c2332fa53d *R/RcppExports.R d0f9453a84225e4a8c027dde506decd4 *R/aux_FISCH.R 650525c31ab3a1065674dc6a1cbc806b *R/auxiliary.R cbb17297ca15c84b8af55c422d755150 *R/init.R 87e25103f290a404090284537333475b *R/lsolve_BICG.R 302b994507af65415a971985b45991e1 *R/lsolve_BICGSTAB.R beac083197f7e24303f59ff6887e45e8 *R/lsolve_CG.R f83478fcb9b33e6bcc2613b4219611a0 *R/lsolve_CGS.R 25622805fadb9bb9443f2c28ba8dfd82 *R/lsolve_CHEBY.R 560204b27b88dfbcb097373c331de9bd *R/lsolve_GMRES.R f36b3b2fef20c3b75f109f1eab4baaba *R/lsolve_GS.R f66ee88f33b86c187aae6c5ef0e7f041 *R/lsolve_JACOBI.R d3d09b0dfb5917be05d0bd5abbe39986 *R/lsolve_QMR.R ff63252ba636b340560e492d9eb7bad6 *R/lsolve_SOR.R e89f74ac6e646823351397c7e2f246f2 *R/lsolve_SSOR.R 769dfb3b226a7995593ff827dc8a6962 *R/package-Rlinsolve.R cb2723ba8ff1055641f21307b04bc15f *build/partial.rdb e6e8d3e61ab65e139ede34439c4eed61 *inst/REFERENCES.bib ad9babbfc5cd9cf61eac9d06429058ee *man/aux_FISCH.Rd c3a6c6e7d41549511eb46d150ac8a968 *man/basic_GS.Rd b933460053ac589739674bd9bb8a69e2 *man/basic_JACOBI.Rd 2e34d52037b115609505ec51a1e34ad5 *man/basic_SOR.Rd 6e5e8e118cde5489388c932f9d68f442 *man/basic_SSOR.Rd 7264e10ac9bcfd0dfd49b6f2ccb5fcb4 *man/krylov_BICG.Rd cc629bf48c4d10fa3d6a85d7d1ea416d *man/krylov_BICGSTAB.Rd 0d5eb25648cfad3b362270649896758d *man/krylov_CG.Rd 753428399e59909143bd712ef52b0ff2 *man/krylov_CGS.Rd acf152a54006a5e80930ce8b45316f84 *man/krylov_CHEBY.Rd b32ec84f7734864cbaa8ee6b67a1971c *man/krylov_GMRES.Rd 9f8e65d526923253dcc6879b831abec8 *man/krylov_QMR.Rd f6ad1ae507d20e40af58c53e59fdaca3 *src/Makevars f6ad1ae507d20e40af58c53e59fdaca3 *src/Makevars.win 9b3fb667c85e6edc09ce812d5336119a *src/RcppExports.cpp 326877fa2f968e84545e00fcb163d0d3 *src/krylov_bicg.cpp 9038677d6748820797effdbf7cab69ea *src/krylov_bicgstab.cpp f2b1b024bd444a6e206c962ea58495e8 *src/krylov_cg.cpp 4b951d31e89d6fa86232cbf8674acdf5 *src/krylov_cgs.cpp 321a691071cf9ea8f620398f7f31931d *src/krylov_cheby.cpp b3c50abfc3a291682c7aee08d860c66d *src/krylov_gmres.cpp 68291696e0455ea485e789a46a4edc86 *src/krylov_qmr.cpp bba99f47273b068366124414d85593e4 *src/method_gs.cpp fa811b26c2d34362b3c1213c659fee76 *src/method_jacobi.cpp 036834ba825fd3fd8b8c979b18515cca *src/method_sor.cpp 19fce4365b786e03c1d3af402b39dd9e *src/method_ssor.cpp Rlinsolve/R/0000755000176200001440000000000015063670677012451 5ustar liggesusersRlinsolve/R/RcppExports.R0000644000176200001440000001015715063670677015071 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #' @keywords internal #' @noRd linsolve.bicg.single <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_bicg`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.bicg.single.sparse <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_bicg_sparse`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.bicgstab.single <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_bicgstab`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.bicgstab.single.sparse <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_bicgstab_sparse`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.cg.single <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_cg`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.cg.single.sparse <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_cg_sparse`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.cgs.single <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_cgs`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.cgs.single.sparse <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_cgs_sparse`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.cheby.single <- function(A, b, xinit, reltol, maxiter, M, eigmax, eigmin) { .Call(`_Rlinsolve_single_cheby`, A, b, xinit, reltol, maxiter, M, eigmax, eigmin) } #' @keywords internal #' @noRd linsolve.cheby.single.sparse <- function(A, b, xinit, reltol, maxiter, M, eigmax, eigmin) { .Call(`_Rlinsolve_single_cheby_sparse`, A, b, xinit, reltol, maxiter, M, eigmax, eigmin) } #' @keywords internal #' @noRd linsolve.gmres.single <- function(A, b, xinit, reltol, maxiter, M, restrt) { .Call(`_Rlinsolve_single_gmres`, A, b, xinit, reltol, maxiter, M, restrt) } #' @keywords internal #' @noRd linsolve.gmres.single.sparse <- function(A, b, xinit, reltol, maxiter, M, restrt) { .Call(`_Rlinsolve_single_gmres_sparse`, A, b, xinit, reltol, maxiter, M, restrt) } #' @keywords internal #' @noRd linsolve.qmr.single <- function(A, b, xinit, reltol, maxiter, M) { .Call(`_Rlinsolve_single_qmr`, A, b, xinit, reltol, maxiter, M) } #' @keywords internal #' @noRd linsolve.qmr.single.sparse <- function(A, b, xinit, reltol, maxiter, M, M1, M2) { .Call(`_Rlinsolve_single_qmr_sparse`, A, b, xinit, reltol, maxiter, M, M1, M2) } #' @keywords internal #' @noRd linsolve.gs.single <- function(A, b, xinit, reltol, maxiter, dflagval) { .Call(`_Rlinsolve_single_gs`, A, b, xinit, reltol, maxiter, dflagval) } #' @keywords internal #' @noRd linsolve.gs.single.sparse <- function(A, b, xinit, reltol, maxiter, dflagval) { .Call(`_Rlinsolve_single_gs_sparse`, A, b, xinit, reltol, maxiter, dflagval) } #' @keywords internal #' @noRd linsolve.jacobi.single <- function(A, b, xinit, reltol, maxiter, weight) { .Call(`_Rlinsolve_single_jacobi`, A, b, xinit, reltol, maxiter, weight) } #' @keywords internal #' @noRd linsolve.jacobi.single.sparse <- function(A, b, xinit, reltol, maxiter, weight) { .Call(`_Rlinsolve_single_jacobi_sparse`, A, b, xinit, reltol, maxiter, weight) } #' @keywords internal #' @noRd linsolve.sor.single <- function(A, b, xinit, reltol, maxiter, w) { .Call(`_Rlinsolve_single_sor`, A, b, xinit, reltol, maxiter, w) } #' @keywords internal #' @noRd linsolve.sor.single.sparse <- function(A, b, xinit, reltol, maxiter, w) { .Call(`_Rlinsolve_single_sor_sparse`, A, b, xinit, reltol, maxiter, w) } #' @keywords internal #' @noRd linsolve.ssor.single <- function(A, b, xinit, reltol, maxiter, w) { .Call(`_Rlinsolve_single_ssor`, A, b, xinit, reltol, maxiter, w) } #' @keywords internal #' @noRd linsolve.ssor.single.sparse <- function(A, b, xinit, reltol, maxiter, w) { .Call(`_Rlinsolve_single_ssor_sparse`, A, b, xinit, reltol, maxiter, w) } Rlinsolve/R/aux_FISCH.R0000644000176200001440000000414215063666222014275 0ustar liggesusers#' Generate a 2-dimensional discrete Poisson matrix #' #' Poisson equation is one of most well-known elliptic partial differential equations. In order to #' give a concrete example, a discrete Poisson matrix is generated, assuming we have \code{N} number of #' grid points for each dimension under square domain. \emph{fisch} is a German word for Poisson. #' #' @param N the number of grid points for each direction. #' @param sparse a logical; \code{TRUE} for returning sparse matrix, \code{FALSE} otherwise. #' #' @return an \eqn{(N^2 \times N^2)} matrix having block banded structure. #' @examples #' ## generate dense and sparse Poisson matrix of size 25 by 25. #' A = aux.fisch(5, sparse=FALSE) #' B = aux.fisch(5, sparse=TRUE) #' (all(A==B)) # TRUE if two matrices are equal. #' #' #' @references Golub, G. H. and Van Loan, C. F. (1996) \emph{Matrix Computations, 3rd Ed.}, pages 177–180. #' @rdname aux_FISCH #' @export aux.fisch <- function(N,sparse=FALSE){ if ((!is.numeric(N))||(is.na(N))||(is.infinite(N))||(length(N)>1)||(N<=2)){ stop("* aux.fisch : an input 'N' should be a positive integer larger than 2.") } if (!is.logical(sparse)){ stop("* aux.fisch : 'sparse' is a logical flag.") } siz = as.integer(N) leng = siz*siz; dia = matrix(0,nrow=siz,ncol=siz) diag(dia) = 4; for (i in 1:(siz-1)){ dia[i,i+1] = -1; dia[i+1,i] = -1; } if (sparse){ mat = Matrix(0,nrow=leng,ncol=leng) } else { mat = matrix(0,nrow=leng,ncol=leng) } if (!sparse){ for (ib in 1:siz){ mat[(1+(ib-1)*siz):(ib*siz),(1+(ib-1)*siz):(ib*siz)] = dia } for (ib in 1:(siz-1)){ mat[(1+(ib-1)*siz):(ib*siz),(1+ib*siz):((ib+1)*siz)] = -diag(siz) mat[(1+ib*siz):((ib+1)*siz),(1+(ib-1)*siz):(ib*siz)] = -diag(siz) } } else { dia = Matrix(dia,sparse=TRUE) off = Matrix(-diag(siz),sparse=TRUE) for (ib in 1:siz){ mat[(1+(ib-1)*siz):(ib*siz),(1+(ib-1)*siz):(ib*siz)] = dia } for (ib in 1:(siz-1)){ mat[(1+(ib-1)*siz):(ib*siz),(1+ib*siz):((ib+1)*siz)] = off mat[(1+ib*siz):((ib+1)*siz),(1+(ib-1)*siz):(ib*siz)] = off } } return(mat) } Rlinsolve/R/lsolve_QMR.R0000644000176200001440000001471115063666222014612 0ustar liggesusers#' Quasi Minimal Residual Method #' #' Quasia-Minimal Resudial(QMR) method is another remedy of the BiCG which shows #' rather irregular convergence behavior. It adapts to solve the reduced tridiagonal system #' in a least squares sense and its convergence is known to be quite smoother than BiCG. #' #' @param A an \eqn{(m\times n)} dense or sparse matrix. See also \code{\link[Matrix]{sparseMatrix}}. #' @param B a vector of length \eqn{m} or an \eqn{(m\times k)} matrix (dense or sparse) for solving \eqn{k} systems simultaneously. #' @param xinit a length-\eqn{n} vector for initial starting point. \code{NA} to start from a random initial point near 0. #' @param reltol tolerance level for stopping iterations. #' @param maxiter maximum number of iterations allowed. #' @param preconditioner an \eqn{(n\times n)} preconditioning matrix; default is an identity matrix. #' @param verbose a logical; \code{TRUE} to show progress of computation. #' #' @return a named list containing \describe{ #' \item{x}{solution; a vector of length \eqn{n} or a matrix of size \eqn{(n\times k)}.} #' \item{iter}{the number of iterations required.} #' \item{errors}{a vector of errors for stopping criterion.} #' } #' #' @examples #' \donttest{ #' ## Overdetermined System #' set.seed(100) #' A = matrix(rnorm(10*5),nrow=10) #' x = rnorm(5) #' b = A%*%x #' #' out1 = lsolve.cg(A,b) #' out2 = lsolve.bicg(A,b) #' out3 = lsolve.qmr(A,b) #' matout = cbind(matrix(x),out1$x, out2$x, out3$x); #' colnames(matout) = c("true x","CG result", "BiCG result", "QMR result") #' print(matout) #' } #' #' @references #' \insertRef{freund_qmr:_1991}{Rlinsolve} #' #' @rdname krylov_QMR #' @export lsolve.qmr <- function(A,B,xinit=NA,reltol=1e-5,maxiter=1000, preconditioner=diag(ncol(A)),verbose=TRUE){ ########################################################################### # Step 0. Initialization if (verbose){ message("* lsolve.qmr : Initialiszed.") } if (any(is.na(A))||any(is.infinite(A))||any(is.na(B))||any(is.infinite(B))){ stop("* lsolve.qmr : no NA or Inf values allowed.") } sparseformats = c("dgCMatrix","dtCMatrix","dsCMatrix") if (aux.is.sparse(A)||aux.is.sparse(B)||aux.is.sparse(preconditioner)){ A = Matrix(A,sparse=TRUE) B = Matrix(B,sparse=TRUE) preconditioner = Matrix(preconditioner,sparse=TRUE) sparseflag = TRUE } else { A = matrix(A,nrow=nrow(A)) if (is.vector(B)){ B = matrix(B) } else { B = matrix(B,nrow=nrow(B)) } preconditioner = matrix(preconditioner,nrow=nrow(preconditioner)) sparseflag = FALSE } # xinit if (length(xinit)==1){ if (is.na(xinit)){ xinit = matrix(rnorm(ncol(A))) } else { stop("* lsolve.qmr : please use a valid 'xinit'.") } } else { if (length(xinit)!=ncol(A)){ stop("* lsolve.qmr : 'xinit' has invalid size.") } xinit = matrix(xinit) } ########################################################################### # Step 1. Preprocessing # 1-1. Neither NA nor Inf allowed. if (any(is.infinite(A))||any(is.na(A))||any(is.infinite(B))||any(is.na(B))){ stop("* lsolve.qmr : no NA, Inf, -Inf values are allowed.") } # 1-2. Size Argument m = nrow(A) if (is.vector(B)){ mB = length(B) if (m!=mB){ stop("* lsolve.qmr : a vector B should have a length of nrow(A).") } } else { mB = nrow(B) if (m!=mB){ stop("* lsolve.qmr : an input matrix B should have the same number of rows from A.") } } if (is.vector(B)){ B = as.matrix(B) } # 1-3. Adjusting Case if (m > ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.qmr : underdetermined case is not supported.") } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.qmr : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.qmr : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation ncolB = ncol(B) if (ncolB==1){ if (sparseflag){ luM = lu(preconditioner) M1 = luM@L M2 = luM@U } if (!sparseflag){ vecB = as.vector(B) res = linsolve.qmr.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = B res = linsolve.qmr.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner,M1,M2) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors = list() if (sparseflag){ luM = lu(preconditioner) M1 = luM@L M2 = luM@U } for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.qmr.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.qmr.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner,M1,M2) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.qmr : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } ########################################################################### # Step 3. Finalize if ("flag" %in% names(res)){ flagval = res$flag if (flagval==0){ if (verbose){ message("* lsolve.qmr : convergence well achieved.") } } else if (flagval==1){ if (verbose){ message("* lsolve.qmr : convergence not achieved within maxiter.") } } else if (flagval==-1){ if (verbose){ message("* lsolve.qmr : breakdown due to degenerate 'rho' value.") } } else if (flagval==-2){ if (verbose){ message("* lsolve.qmr : breakdown due to degenerate 'beta' value.") } } else if (flagval==-3){ if (verbose){ message("* lsolve.qmr : breakdown due to degenerate 'gamma' value.") } } else if (flagval==-4){ if (verbose){ message("* lsolve.qmr : breakdown due to degenerate 'delta' value.") } } else if (flagval==-5){ if (verbose){ message("* lsolve.qmr : breakdown due to degenerate 'ep' value.") } } else if (flagval==-6){ if (verbose){ message("* lsolve.qmr : breakdown due to degenerate 'xi' value.") } } res$flag = NULL } if (verbose){ message("* lsolve.qmr : computations finished.") } return(res) } Rlinsolve/R/lsolve_GMRES.R0000644000176200001440000001405515063666222015031 0ustar liggesusers#' Generalized Minimal Residual method #' #' GMRES is a generic iterative solver for a nonsymmetric system of linear equations. As its name suggests, it approximates #' the solution using Krylov vectors with minimal residuals. #' #' @param A an \eqn{(m\times n)} dense or sparse matrix. See also \code{\link[Matrix]{sparseMatrix}}. #' @param B a vector of length \eqn{m} or an \eqn{(m\times k)} matrix (dense or sparse) for solving \eqn{k} systems simultaneously. #' @param xinit a length-\eqn{n} vector for initial starting point. \code{NA} to start from a random initial point near 0. #' @param reltol tolerance level for stopping iterations. #' @param maxiter maximum number of iterations allowed. #' @param preconditioner an \eqn{(n\times n)} preconditioning matrix; default is an identity matrix. #' @param restart the number of iterations before restart. #' @param verbose a logical; \code{TRUE} to show progress of computation. #' #' @return a named list containing \describe{ #' \item{x}{solution; a vector of length \eqn{n} or a matrix of size \eqn{(n\times k)}.} #' \item{iter}{the number of iterations required.} #' \item{errors}{a vector of errors for stopping criterion.} #' } #' #' @examples #' \donttest{ #' ## Overdetermined System #' set.seed(100) #' A = matrix(rnorm(10*5),nrow=10) #' x = rnorm(5) #' b = A%*%x #' #' out1 = lsolve.cg(A,b) #' out3_1 = lsolve.gmres(A,b,restart=2) #' out3_2 = lsolve.gmres(A,b,restart=3) #' out3_3 = lsolve.gmres(A,b,restart=4) #' matout = cbind(matrix(x),out1$x, out3_1$x, out3_2$x, out3_3$x); #' colnames(matout) = c("true x","CG", "GMRES(2)", "GMRES(3)", "GMRES(4)") #' print(matout) #' } #' #' @references #' \insertRef{saad_gmres:_1986}{Rlinsolve} #' #' @rdname krylov_GMRES #' @export lsolve.gmres <- function(A,B,xinit=NA,reltol=1e-5,maxiter=1000, preconditioner=diag(ncol(A)),restart=(ncol(A)-1),verbose=TRUE){ ########################################################################### # Step 0. Initialization if (verbose){ message("* lsolve.gmres : Initialiszed.") } if (any(is.na(A))||any(is.infinite(A))||any(is.na(B))||any(is.infinite(B))){ stop("* lsolve.gmres : no NA or Inf values allowed.") } sparseformats = c("dgCMatrix","dtCMatrix","dsCMatrix") if (aux.is.sparse(A)||aux.is.sparse(B)||aux.is.sparse(preconditioner)){ A = Matrix(A,sparse=TRUE) B = Matrix(B,sparse=TRUE) preconditioner = Matrix(preconditioner,sparse=TRUE) sparseflag = TRUE } else { A = matrix(A,nrow=nrow(A)) if (is.vector(B)){ B = matrix(B) } else { B = matrix(B,nrow=nrow(B)) } preconditioner = matrix(preconditioner,nrow=nrow(preconditioner)) sparseflag = FALSE } # xinit if (length(xinit)==1){ if (is.na(xinit)){ xinit = matrix(rnorm(ncol(A))) } else { stop("* lsolve.gmres : please use a valid 'xinit'.") } } else { if (length(xinit)!=ncol(A)){ stop("* lsolve.gmres : 'xinit' has invalid size.") } xinit = matrix(xinit) } if ((restart<2)||(is.na(restart))||(is.infinite(restart))||(abs(restart-round(restart))>sqrt(.Machine$double.eps))){ stop("* lsolve.gmres : 'restart' should be a positive integer >= 2.") } restart = round(restart) if (restart>=ncol(A)){ stop("* lsolve.gmres : take a restart value smaller than ncol(A).") } ########################################################################### # Step 1. Preprocessing # 1-1. Neither NA nor Inf allowed. if (any(is.infinite(A))||any(is.na(A))||any(is.infinite(B))||any(is.na(B))){ stop("* lsolve.gmres : no NA, Inf, -Inf values are allowed.") } # 1-2. Size Argument m = nrow(A) if (is.vector(B)){ mB = length(B) if (m!=mB){ stop("* lsolve.gmres : a vector B should have a length of nrow(A).") } } else { mB = nrow(B) if (m!=mB){ stop("* lsolve.gmres : an input matrix B should have the same number of rows from A.") } } if (is.vector(B)){ B = as.matrix(B) } # 1-3. Adjusting Case if (m > ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.gmres : underdetermined case is not supported.") } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.gmres : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.gmres : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.gmres.single(A,vecB,xinit,reltol,maxiter,preconditioner,restart) } else { vecB = B res = linsolve.gmres.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner,restart) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.gmres.single(A,vecB,xinit,reltol,maxiter,preconditioner,restart) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.gmres.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner,restart) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.gmres : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } ########################################################################### # Step 3. Finalize if ("flag" %in% names(res)){ flagval = res$flag if (flagval==0){ if (verbose){ message("* lsolve.gmres : convergence well achieved.") } } else if (flagval==1){ if (verbose){ message("* lsolve.gmres : convergence not achieved within maxiter.") } } else { if (verbose){ message("* lsolve.gmres : breakdown.") } } res$flag = NULL } if (verbose){ message("* lsolve.gmres : computations finished.") } return(res) } Rlinsolve/R/lsolve_GS.R0000644000176200001440000001306215063666352014466 0ustar liggesusers#' Gauss-Seidel method #' #' Gauss-Seidel(GS) method is an iterative algorithm for solving a system of linear equations, #' with a decomposition \eqn{A = D+L+U} where \eqn{D} is a diagonal matrix and #' \eqn{L} and \eqn{U} are strictly lower/upper triangular matrix respectively. #' For a square matrix \eqn{A}, it is required to be diagonally dominant or symmetric and positive definite. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A)1e-10){ if (verbose){ message("* lsolve.gs : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.gs : making it normal equation form via 'adjsym' flag.") } } } } # Preprocessing : gs only : symmetric method dflagval = as.integer(1) # Preprocessing : no NA or Inf if (any(is.infinite(A))||any(is.na(A))||any(is.infinite(B))||any(is.na(B))){ stop("* lsolve.gs : no NA, Inf, -Inf values are allowed.") } # Preprocessing : size argument : A and B m = nrow(A) if (is.vector(B)){ mB = length(B) if (m!=mB){ stop("* lsolve.gs : a vector B should have a length of nrow(A).") } } else { mB = nrow(B) if (m!=mB){ stop("* lsolve.gs : an input matrix B should have the same number of rows from A.") } } if (is.vector(B)){ B = as.matrix(B) } # Preprocessing : size argument : A case # Overdetermined - A'Ax = A'b # Underdetermined - not supporting this case. n = ncol(A) if (mn){ B = (t(A)%*%B) A = (t(A)%*%A) if (verbose){ message("* lsolve.gs : overdetermined case : turning into normal equation.") } } # Preprocessing : aux.is.dd if (aux.is.dd(A)==FALSE){ if (verbose){ message("* lsolve.gs : LHS matrix A is not diagonally dominant.") message("* : solution from Gauss-Seidel method is not guaranteed.") } } # Preprocessing : adjust diagonal entries for A if (any(diag(A)==0)){ cvec = rnorm(10) adjconst = cvec[sample(which(cvec!=0),1)]/(1e+5) diag(A) = diag(A)+adjconst } # Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.gs.single(A,vecB,xinit,reltol,maxiter,dflagval) } else { vecB = B res = linsolve.gs.single.sparse(A,vecB,xinit,reltol,maxiter,dflagval) } } else { x = array(0,c(n,ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.gs.single(A,vecB,xinit,reltol,maxiter,dflagval) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.gs.single.sparse(A,vecB,xinit,reltol,maxiter,dflagval) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.gs : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } # Return if (verbose){ message("* lsolve.gs : computations finished.") } return(res) } Rlinsolve/R/auxiliary.R0000644000176200001440000000301015063666222014564 0ustar liggesusers # Auxiliary Functions ----------------------------------------------------- # Aux 1:: aux.is.dd(w/ doc) : check if diagonally dominant # Aux 2:: aux.is.psd : check positive semidefinite # Aux 3:: aux.is.sparse : sparseformats = c("dgCMatrix","dtCMatrix","dsCMatrix") # ----------------------------------------------------------------------- # Aux 3:: aux.is.sparse : check whether one of the following #' @keywords internal #' @noRd aux.is.sparse <- function(AA){ sparseformats = c("dgCMatrix","dtCMatrix","dsCMatrix") for (i in 1:3){ if (inherits(AA, sparseformats[i])){ return(TRUE) } } return(FALSE) } # ------------------------------------------------------------------------ # Aux 1:: aux.is.dd # "sdd" : strictly # "wdd" : weakly # FALSE : not at all #' @keywords internal #' @noRd aux.is.dd <- function(A){ absA = abs(A) # 1-1. separate terms diagA = 2*(diag(absA)) offdA = colSums(absA) # 1-2. logic if (all(diagA>offdA)){ res = "sdd" } else if ((all(diagA>=offdA))&&(any(diagA==offdA))){ res = "wdd" } else { res = FALSE } return(res) } # ------------------------------------------------------------------------ # Aux 2:: aux.is.psd #' Positive Semidefiniteness #' PD, PSD, or FALSE #' #' @keywords internal #' @noRd aux.is.psd <- function(A){ # get eigenvalues eigs = eigen(A, only.values = TRUE) # PD, PSD, or FALSE if (all(eigs>0)){res = "PD"} else if ((all(eigs>=0))&&(any(eigs>0))){res = "PSD"} else {res = FALSE} # finalize return(res) } Rlinsolve/R/lsolve_BICGSTAB.R0000644000176200001440000001401615063666222015327 0ustar liggesusers#' Biconjugate Gradient Stabilized Method #' #' Biconjugate Gradient Stabilized(BiCGSTAB) method is a stabilized version of Biconjugate Gradient method for nonsymmetric systems using #' evaluations with respect to \eqn{A^T} as well as \eqn{A} in matrix-vector multiplications. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A) ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.bicgstab : underdetermined case is not supported.") } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.bicgstab : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.bicgstab : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.bicgstab.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = B res = linsolve.bicgstab.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.bicgstab.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.bicgstab.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.bicgstab : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } ########################################################################### # Step 3. Finalize if ("flag" %in% names(res)){ flagval = res$flag if (flagval==0){ if (verbose){ message("* lsolve.bicgstab : convergence well achieved.") } } else if (flagval==1){ if (verbose){ message("* lsolve.bicgstab : convergence not achieved within maxiter.") } } else { if (verbose){ message("* lsolve.bicgstab : breakdown.") } } res$flag = NULL } if (verbose){ message("* lsolve.bicgstab : computations finished.") } return(res) } Rlinsolve/R/lsolve_BICG.R0000644000176200001440000001367215063666222014664 0ustar liggesusers#' Biconjugate Gradient method #' #' Biconjugate Gradient(BiCG) method is a modification of Conjugate Gradient for nonsymmetric systems using #' evaluations with respect to \eqn{A^T} as well as \eqn{A} in matrix-vector multiplications. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A) ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.bicg : underdetermined case is not supported.") } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.bicg : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.bicg : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.bicg.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = B res = linsolve.bicg.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors1 = list() errors2 = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.bicg.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.bicg.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } x[,i] = tmpres$x iter[i] = tmpres$iter errors1[[i]] = tmpres$errors1 errors2[[i]] = tmpres$errors2 if (verbose){ message(paste("* lsolve.bicg : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors1"=errors1,"errors2"=errors2) } ########################################################################### # Step 3. Finalize if ("flag" %in% names(res)){ flagval = res$flag if (flagval==0){ if (verbose){ message("* lsolve.bicg : convergence well achieved.") } } else if (flagval==1){ if (verbose){ message("* lsolve.bicg : convergence not achieved within maxiter.") } } else { if (verbose){ message("* lsolve.bicg : breakdown.") } } } if (verbose){ message("* lsolve.bicg : computations finished.") } return(res) } Rlinsolve/R/init.R0000644000176200001440000000176115063666417013541 0ustar liggesusers.pkgenv <- new.env(parent = emptyenv()) .onAttach <- function(...){ ## Retrieve Year Information date <- date() x <- regexpr("[0-9]{4}", date) this.year <- substr(date, x[1], x[1] + attr(x, "match.length") - 1) # Retrieve Current Version this.version = packageVersion("Rlinsolve") ## Print on Screen packageStartupMessage("** ------------------------------------------------------- **") packageStartupMessage("** Rlinsolve") packageStartupMessage("** - Solving (Sparse) System of Linear Equations") packageStartupMessage("**") packageStartupMessage("** Version : ",this.version," (",this.year,")",sep="") packageStartupMessage("** Maintainer : Kisung You (kisung.you@outlook.com)") packageStartupMessage("**") packageStartupMessage("** Please share any bugs or suggestions to the maintainer.") packageStartupMessage("** ------------------------------------------------------- **") } .onUnload <- function(libpath) { library.dynam.unload("Rlinsolve", libpath) }Rlinsolve/R/lsolve_CGS.R0000644000176200001440000001451115063666222014565 0ustar liggesusers#' Conjugate Gradient Squared method #' #' Conjugate Gradient Squared(CGS) method is an extension of Conjugate Gradient method where the system #' is symmetric and positive definite. It aims at achieving faster convergence using an idea of #' contraction operator twice. For a square matrix \eqn{A},it is required to be symmetric and positive definite. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A) ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.cgs : underdetermined case is not supported.") } else { ## Case 3. Square Size if (norm(abs(t(A)-A),"f")>1e-10){ if (verbose){ message("* lsolve.cgs : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.cgs : making it normal equation form via 'adjsym' flag.") } } } } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.cgs : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.cgs : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.cgs.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = B res = linsolve.cgs.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.cgs.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.cgs.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.cgs : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } ########################################################################### # Step 3. Finalize if ("flag"%in%names(res)){ flagval = res$flag; if (flagval==0){ if (verbose){ message("* lsolve.cgs : convergence was well achieved.") } } else { if (verbose){ message("* lsolve.cgs : convergence was not achieved within maxiter.") } } res$flag = NULL } if (verbose){ message("* lsolve.cgs : computations finished.") } return(res) } Rlinsolve/R/lsolve_JACOBI.R0000644000176200001440000001464615063666222015111 0ustar liggesusers#' Jacobi method #' #' Jacobi method is an iterative algorithm for solving a system of linear equations, #' with a decomposition \eqn{A = D+R} where \eqn{D} is a diagonal matrix. #' For a square matrix \eqn{A}, it is required to be diagonally dominant. For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A)1e-10){ if (verbose){ message("* lsolve.jacobi : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.jacobi : making it normal equation form via 'adjsym' flag.") } } } } # Preprocessing : JACOBI ONLY : weight should be (0,1] if ((weight<=0)||(weight>1)){ stop("* lsolve.jacobi : weight should be a positive real number in (0,1].") } # Preprocessing : no NA or Inf if (any(is.infinite(A))||any(is.na(A))||any(is.infinite(B))||any(is.na(B))){ stop("* lsolve.jacobi : no NA, Inf, -Inf values are allowed.") } # Preprocessing : size argument : A and B m = nrow(A) if (is.vector(B)){ mB = length(B) if (m!=mB){ stop("* lsolve.jacobi : a vector B should have a length of nrow(A).") } } else { mB = nrow(B) if (m!=mB){ stop("* lsolve.jacobi : an input matrix B should have the same number of rows from A.") } } if (is.vector(B)){ B = as.matrix(B) } # Preprocessing : size argument : A case # Overdetermined - A'Ax = A'b # Underdetermined - not supporting this case. n = ncol(A) if (mn){ B = (t(A)%*%B) A = (t(A)%*%A) if (verbose){ message("* lsolve.jacobi : overdetermined case : turning into normal equation.") } } # Preprocessing : aux.is.dd if (aux.is.dd(A)==FALSE){ if (verbose){ message("* lsolve.jacobi : LHS matrix A is not diagonally dominant.") message("* : solution from Jacobi method is not guaranteed.") } } # # Preprocessing : aux.is.dd # if (aux.is.dd(A)==FALSE){ # if (verbose){ # message("* lsolve.jacobi : LHS matrix A is not diagonally dominant.") # message("* : solution from Jacobi method is not guaranteed.") # } # } # Preprocessing : adjust diagonal entries for A if (any(diag(A)==0)){ cvec = rnorm(10) adjconst = cvec[sample(which(cvec!=0),1)]/(1e+5) diag(A) = diag(A)+adjconst } # Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.jacobi.single(A,vecB,xinit,reltol,maxiter,weight) } else { vecB = B res = linsolve.jacobi.single.sparse(A,vecB,xinit,reltol,maxiter,weight) } } else { x = array(0,c(n,ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.jacobi.single(A,vecB,xinit,reltol,maxiter,weight) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.jacobi.single.sparse(A,vecB,xinit,reltol,maxiter,weight) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.jacobi : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } # Return if (verbose){ message("* lsolve.jacobi : computations finished.") } return(res) } Rlinsolve/R/package-Rlinsolve.R0000644000176200001440000000660115063666275016144 0ustar liggesusers#' A Collection of Iterative Solvers for (Sparse) Linear System of Equations #' #' Solving a system of linear equations is one of the most fundamental #' computational problems for many fields of mathematical studies, such as #' regression from statistics or numerical partial differential equations. #' We provide a list of both stationary and nonstationary solvers. Sparse #' matrix class from \pkg{Matrix} is also supported for large sparse system. #' #' @section Non-square matrix: #' For a matrix \eqn{A} of size \code{(m-by-n)}, we say the system is #' \strong{overdetermined} if \code{m>n}, \strong{underdetermined} if \code{m ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.cheby : underdetermined case is not supported.") } else { ## Case 3. Square Size if (norm(abs(t(A)-A),"f")>1e-10){ if (verbose){ message("* lsolve.cheby : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.cheby : making it normal equation form via 'adjsym' flag.") } } } } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.cheby : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.cheby : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation eigs = solve(preconditioner, A) eigsdec = eigen(eigs, only.values = TRUE) eigmax = max(eigsdec$values) eigmin = min(eigsdec$values) ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.cheby.single(A,vecB,xinit,reltol,maxiter,preconditioner,eigmax,eigmin) } else { vecB = B res = linsolve.cheby.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner,eigmax,eigmin) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.cheby.single(A,vecB,xinit,reltol,maxiter,preconditioner,eigmax,eigmin) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.cheby.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner,eigmax,eigmin) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.cheby : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } if ("flag"%in%names(res)){ flagval = res$flag; if (flagval==0){ if (verbose){ message("* lsolve.cheby : convergence was well achieved.") } } else { if (verbose){ message("* lsolve.cheby : convergence was not achieved within maxiter.") } } res$flag = NULL } return(res) if (verbose){ message("* lsolve.cheby : computations finished.") } } Rlinsolve/R/lsolve_SSOR.R0000644000176200001440000001400015063666372014736 0ustar liggesusers#' Symmetric Successive Over-Relaxation method #' #' Symmetric Successive Over-Relaxation(SSOR) method is a variant of Gauss-Seidel method for solving a system of linear equations, #' with a decomposition \eqn{A = D+L+U} where \eqn{D} is a diagonal matrix and #' \eqn{L} and \eqn{U} are strictly lower/upper triangular matrix respectively. #' For a square matrix \eqn{A}, it is required to be diagonally dominant or symmetric and positive definite like GS method. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A)1e-10){ if (verbose){ message("* lsolve.ssor : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.ssor : making it normal equation form via 'adjsym' flag.") } } else { stop("* lsolve.ssor : SSOR must be applied to symmetric matrix A.") } } } # Preprocessing : SSOR only : w if ((w<=0)||(w>=2)){ stop("* lsolve.ssor : weight value w should be in (0,2).") } # Preprocessing : no NA or Inf if (any(is.infinite(A))||any(is.na(A))||any(is.infinite(B))||any(is.na(B))){ stop("* lsolve.ssor : no NA, Inf, -Inf values are allowed.") } # Preprocessing : size argument : A and B m = nrow(A) if (is.vector(B)){ mB = length(B) if (m!=mB){ stop("* lsolve.ssor : a vector B should have a length of nrow(A).") } } else { mB = nrow(B) if (m!=mB){ stop("* lsolve.ssor : an input matrix B should have the same number of rows from A.") } } if (is.vector(B)){ B = as.matrix(B) } # Preprocessing : size argument : A case # Overdetermined - A'Ax = A'b # Underdetermined - not supporting this case. n = ncol(A) if (mn){ B = (t(A)%*%B) A = (t(A)%*%A) if (verbose){ message("* lsolve.ssor : overdetermined case : turning into normal equation.") } } # Preprocessing : aux.is.dd if (aux.is.dd(A)==FALSE){ if (verbose){ message("* lsolve.ssor : LHS matrix A is not diagonally dominant.") } } # Preprocessing : adjust diagonal entries for A if (any(diag(A)==0)){ cvec = rnorm(10) adjconst = cvec[sample(which(cvec!=0),1)]/(1e+5) diag(A) = diag(A)+adjconst } # Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.ssor.single(A,vecB,xinit,reltol,maxiter,w) } else { vecB = B res = linsolve.ssor.single.sparse(A,vecB,xinit,reltol,maxiter,w) } } else { x = array(0,c(n,ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.ssor.single(A,vecB,xinit,reltol,maxiter,w) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.ssor.single.sparse(A,vecB,xinit,reltol,maxiter,w) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.ssor : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } # Return if (verbose){ message("* lsolve.ssor : computations finished.") } return(res) } Rlinsolve/R/lsolve_SOR.R0000644000176200001440000001376615063666362014634 0ustar liggesusers#' Successive Over-Relaxation method #' #' Successive Over-Relaxation(SOR) method is a variant of Gauss-Seidel method for solving a system of linear equations, #' with a decomposition \eqn{A = D+L+U} where \eqn{D} is a diagonal matrix and #' \eqn{L} and \eqn{U} are strictly lower/upper triangular matrix respectively. #' For a square matrix \eqn{A}, it is required to be diagonally dominant or symmetric and positive definite like GS method. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A)1e-10){ if (verbose){ message("* lsolve.sor : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.sor : making it normal equation form via 'adjsym' flag.") } } } } # Preprocessing : SOR only : w if ((w<=0)||(w>=2)){ stop("* lsolve.sor : weight value w should be in (0,2).") } if (w==1){ if (verbose){ message("* lsolve.sor : w=1 : it reduces to forward Gauss-Seidel method.") } } # Preprocessing : no NA or Inf if (any(is.infinite(A))||any(is.na(A))||any(is.infinite(B))||any(is.na(B))){ stop("* lsolve.sor : no NA, Inf, -Inf values are allowed.") } # Preprocessing : size argument : A and B m = nrow(A) if (is.vector(B)){ mB = length(B) if (m!=mB){ stop("* lsolve.sor : a vector B should have a length of nrow(A).") } } else { mB = nrow(B) if (m!=mB){ stop("* lsolve.sor : an input matrix B should have the same number of rows from A.") } } if (is.vector(B)){ B = as.matrix(B) } # Preprocessing : size argument : A case # Overdetermined - A'Ax = A'b # Underdetermined - not supporting this case. n = ncol(A) if (mn){ B = (t(A)%*%B) A = (t(A)%*%A) if (verbose){ message("* lsolve.sor : overdetermined case : turning into normal equation.") } } # Preprocessing : aux.is.dd if (aux.is.dd(A)==FALSE){ if (verbose){ message("* lsolve.sor : LHS matrix A is not diagonally dominant.") } } # Preprocessing : adjust diagonal entries for A if (any(diag(A)==0)){ cvec = rnorm(10) adjconst = cvec[sample(which(cvec!=0),1)]/(1e+5) diag(A) = diag(A)+adjconst } # Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.sor.single(A,vecB,xinit,reltol,maxiter,w) } else { vecB = B res = linsolve.sor.single.sparse(A,vecB,xinit,reltol,maxiter,w) } } else { x = array(0,c(n,ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.sor.single(A,vecB,xinit,reltol,maxiter,w) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.sor.single.sparse(A,vecB,xinit,reltol,maxiter,w) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.sor : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } # Return if (verbose){ message("* lsolve.sor : computations finished.") } return(res) } Rlinsolve/R/lsolve_CG.R0000644000176200001440000001435615063666222014451 0ustar liggesusers#' Conjugate Gradient method #' #' Conjugate Gradient(CG) method is an iterative algorithm for solving a system of linear equations where the system #' is symmetric and positive definite. #' For a square matrix \eqn{A}, it is required to be symmetric and positive definite. #' For an overdetermined system where \code{nrow(A)>ncol(A)}, #' it is automatically transformed to the normal equation. Underdetermined system - #' \code{nrow(A) ncol(A)){ ## Case 1. Overdetermined B = t(A)%*%B A = t(A)%*%A } else if (m < ncol(A)){ ## Case 2. Underdetermined stop("* lsolve.cg : underdetermined case is not supported.") } else { ## Case 3. Square Size if (norm(abs(t(A)-A),"f")>1e-10){ if (verbose){ message("* lsolve.cg : A may not be symmetric.") } if (adjsym){ B = t(A)%*%B A = t(A)%*%A if (verbose){ message("* lsolve.cg : making it normal equation form via 'adjsym' flag.") } } } } # 1-4. Preconditioner : only valid for square case if (!all.equal(dim(A),dim(preconditioner))){ stop("* lsolve.cg : Preconditioner is a size-matching.") } if (verbose){message("* lsolve.cg : preprocessing finished ...")} ########################################################################### # Step 2. Main Computation ncolB = ncol(B) if (ncolB==1){ if (!sparseflag){ vecB = as.vector(B) res = linsolve.cg.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = B res = linsolve.cg.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } } else { x = array(0,c(ncol(A),ncolB)) iter = array(0,c(1,ncolB)) errors = list() for (i in 1:ncolB){ if (!sparseflag){ vecB = as.vector(B[,i]) tmpres = linsolve.cg.single(A,vecB,xinit,reltol,maxiter,preconditioner) } else { vecB = Matrix(B[,i],sparse=TRUE) tmpres = linsolve.cg.single.sparse(A,vecB,xinit,reltol,maxiter,preconditioner) } x[,i] = tmpres$x iter[i] = tmpres$iter errors[[i]] = tmpres$errors if (verbose){ message(paste("* lsolve.cg : B's column.",i,"being processed..")) } } res = list("x"=x,"iter"=iter,"errors"=errors) } ########################################################################### # Step 3. Finalize if ("flag"%in%names(res)){ flagval = res$flag; if (flagval==0){ if (verbose){ message("* lsolve.cg : convergence was well achieved.") } } else { if (verbose){ message("* lsolve.cg : convergence was not achieved within maxiter.") } } res$flag = NULL } if (verbose){ message("* lsolve.cg : computations finished.") } return(res) } Rlinsolve/src/0000755000176200001440000000000015063670770013031 5ustar liggesusersRlinsolve/src/method_sor.cpp0000644000176200001440000000637615063666222015711 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Basic Iterative Solver 3-1. SOR //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.sor.single)]] Rcpp::List single_sor(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const double w){ // 1. seperate terms vec d = diagvec(A); mat D = diagmat(d); mat L = trimatl(A,-1); // omit diagonal for lower mat U = trimatu(A, 1); // omit diagonal for upper // 2. get parameters and set ready int n = A.n_rows; arma::colvec xold = xinit; if (norm(b-A*xinit)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } //------------------------------------------------------------------------------ // Basic Iterative Solver 3-2. SOR : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.sor.single.sparse)]] Rcpp::List single_sor_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const double w){ // 1. seperate terms int n = A.n_rows; arma::sp_mat D = diagmat(A); arma::sp_mat L(n,n); for (int i=1;i=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } Rlinsolve/src/RcppExports.cpp0000644000176200001440000005706015063666410016032 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // single_bicg Rcpp::List single_bicg(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M); RcppExport SEXP _Rlinsolve_single_bicg(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_bicg(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_bicg_sparse Rcpp::List single_bicg_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M); RcppExport SEXP _Rlinsolve_single_bicg_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_bicg_sparse(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_bicgstab Rcpp::List single_bicgstab(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M); RcppExport SEXP _Rlinsolve_single_bicgstab(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_bicgstab(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_bicgstab_sparse Rcpp::List single_bicgstab_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M); RcppExport SEXP _Rlinsolve_single_bicgstab_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_bicgstab_sparse(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_cg Rcpp::List single_cg(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M); RcppExport SEXP _Rlinsolve_single_cg(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_cg(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_cg_sparse Rcpp::List single_cg_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M); RcppExport SEXP _Rlinsolve_single_cg_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_cg_sparse(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_cgs Rcpp::List single_cgs(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M); RcppExport SEXP _Rlinsolve_single_cgs(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_cgs(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_cgs_sparse Rcpp::List single_cgs_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M); RcppExport SEXP _Rlinsolve_single_cgs_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_cgs_sparse(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_cheby Rcpp::List single_cheby(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, arma::mat& M, const double eigmax, const double eigmin); RcppExport SEXP _Rlinsolve_single_cheby(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP, SEXP eigmaxSEXP, SEXP eigminSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< arma::mat& >::type M(MSEXP); Rcpp::traits::input_parameter< const double >::type eigmax(eigmaxSEXP); Rcpp::traits::input_parameter< const double >::type eigmin(eigminSEXP); rcpp_result_gen = Rcpp::wrap(single_cheby(A, b, xinit, reltol, maxiter, M, eigmax, eigmin)); return rcpp_result_gen; END_RCPP } // single_cheby_sparse Rcpp::List single_cheby_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, arma::sp_mat M, const double eigmax, const double eigmin); RcppExport SEXP _Rlinsolve_single_cheby_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP, SEXP eigmaxSEXP, SEXP eigminSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< arma::sp_mat >::type M(MSEXP); Rcpp::traits::input_parameter< const double >::type eigmax(eigmaxSEXP); Rcpp::traits::input_parameter< const double >::type eigmin(eigminSEXP); rcpp_result_gen = Rcpp::wrap(single_cheby_sparse(A, b, xinit, reltol, maxiter, M, eigmax, eigmin)); return rcpp_result_gen; END_RCPP } // single_gmres Rcpp::List single_gmres(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, arma::mat& M, const int restrt); RcppExport SEXP _Rlinsolve_single_gmres(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP, SEXP restrtSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< arma::mat& >::type M(MSEXP); Rcpp::traits::input_parameter< const int >::type restrt(restrtSEXP); rcpp_result_gen = Rcpp::wrap(single_gmres(A, b, xinit, reltol, maxiter, M, restrt)); return rcpp_result_gen; END_RCPP } // single_gmres_sparse Rcpp::List single_gmres_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, arma::sp_mat M, const int restrt); RcppExport SEXP _Rlinsolve_single_gmres_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP, SEXP restrtSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< arma::sp_mat >::type M(MSEXP); Rcpp::traits::input_parameter< const int >::type restrt(restrtSEXP); rcpp_result_gen = Rcpp::wrap(single_gmres_sparse(A, b, xinit, reltol, maxiter, M, restrt)); return rcpp_result_gen; END_RCPP } // single_qmr Rcpp::List single_qmr(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M); RcppExport SEXP _Rlinsolve_single_qmr(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::mat& >::type M(MSEXP); rcpp_result_gen = Rcpp::wrap(single_qmr(A, b, xinit, reltol, maxiter, M)); return rcpp_result_gen; END_RCPP } // single_qmr_sparse Rcpp::List single_qmr_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M, const arma::sp_mat M1, const arma::sp_mat M2); RcppExport SEXP _Rlinsolve_single_qmr_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP MSEXP, SEXP M1SEXP, SEXP M2SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M(MSEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M1(M1SEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type M2(M2SEXP); rcpp_result_gen = Rcpp::wrap(single_qmr_sparse(A, b, xinit, reltol, maxiter, M, M1, M2)); return rcpp_result_gen; END_RCPP } // single_gs Rcpp::List single_gs(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const int dflagval); RcppExport SEXP _Rlinsolve_single_gs(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP dflagvalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const int >::type dflagval(dflagvalSEXP); rcpp_result_gen = Rcpp::wrap(single_gs(A, b, xinit, reltol, maxiter, dflagval)); return rcpp_result_gen; END_RCPP } // single_gs_sparse Rcpp::List single_gs_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const int dflagval); RcppExport SEXP _Rlinsolve_single_gs_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP dflagvalSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const int >::type dflagval(dflagvalSEXP); rcpp_result_gen = Rcpp::wrap(single_gs_sparse(A, b, xinit, reltol, maxiter, dflagval)); return rcpp_result_gen; END_RCPP } // single_jacobi Rcpp::List single_jacobi(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const double weight); RcppExport SEXP _Rlinsolve_single_jacobi(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP weightSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const double >::type weight(weightSEXP); rcpp_result_gen = Rcpp::wrap(single_jacobi(A, b, xinit, reltol, maxiter, weight)); return rcpp_result_gen; END_RCPP } // single_jacobi_sparse Rcpp::List single_jacobi_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const double weight); RcppExport SEXP _Rlinsolve_single_jacobi_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP weightSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const double >::type weight(weightSEXP); rcpp_result_gen = Rcpp::wrap(single_jacobi_sparse(A, b, xinit, reltol, maxiter, weight)); return rcpp_result_gen; END_RCPP } // single_sor Rcpp::List single_sor(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const double w); RcppExport SEXP _Rlinsolve_single_sor(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP wSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const double >::type w(wSEXP); rcpp_result_gen = Rcpp::wrap(single_sor(A, b, xinit, reltol, maxiter, w)); return rcpp_result_gen; END_RCPP } // single_sor_sparse Rcpp::List single_sor_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const double w); RcppExport SEXP _Rlinsolve_single_sor_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP wSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const double >::type w(wSEXP); rcpp_result_gen = Rcpp::wrap(single_sor_sparse(A, b, xinit, reltol, maxiter, w)); return rcpp_result_gen; END_RCPP } // single_ssor Rcpp::List single_ssor(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const double w); RcppExport SEXP _Rlinsolve_single_ssor(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP wSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::mat& >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::colvec& >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const double >::type w(wSEXP); rcpp_result_gen = Rcpp::wrap(single_ssor(A, b, xinit, reltol, maxiter, w)); return rcpp_result_gen; END_RCPP } // single_ssor_sparse Rcpp::List single_ssor_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const double w); RcppExport SEXP _Rlinsolve_single_ssor_sparse(SEXP ASEXP, SEXP bSEXP, SEXP xinitSEXP, SEXP reltolSEXP, SEXP maxiterSEXP, SEXP wSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< const arma::sp_mat >::type A(ASEXP); Rcpp::traits::input_parameter< const arma::sp_mat >::type b(bSEXP); Rcpp::traits::input_parameter< arma::colvec& >::type xinit(xinitSEXP); Rcpp::traits::input_parameter< const double >::type reltol(reltolSEXP); Rcpp::traits::input_parameter< const int >::type maxiter(maxiterSEXP); Rcpp::traits::input_parameter< const double >::type w(wSEXP); rcpp_result_gen = Rcpp::wrap(single_ssor_sparse(A, b, xinit, reltol, maxiter, w)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_Rlinsolve_single_bicg", (DL_FUNC) &_Rlinsolve_single_bicg, 6}, {"_Rlinsolve_single_bicg_sparse", (DL_FUNC) &_Rlinsolve_single_bicg_sparse, 6}, {"_Rlinsolve_single_bicgstab", (DL_FUNC) &_Rlinsolve_single_bicgstab, 6}, {"_Rlinsolve_single_bicgstab_sparse", (DL_FUNC) &_Rlinsolve_single_bicgstab_sparse, 6}, {"_Rlinsolve_single_cg", (DL_FUNC) &_Rlinsolve_single_cg, 6}, {"_Rlinsolve_single_cg_sparse", (DL_FUNC) &_Rlinsolve_single_cg_sparse, 6}, {"_Rlinsolve_single_cgs", (DL_FUNC) &_Rlinsolve_single_cgs, 6}, {"_Rlinsolve_single_cgs_sparse", (DL_FUNC) &_Rlinsolve_single_cgs_sparse, 6}, {"_Rlinsolve_single_cheby", (DL_FUNC) &_Rlinsolve_single_cheby, 8}, {"_Rlinsolve_single_cheby_sparse", (DL_FUNC) &_Rlinsolve_single_cheby_sparse, 8}, {"_Rlinsolve_single_gmres", (DL_FUNC) &_Rlinsolve_single_gmres, 7}, {"_Rlinsolve_single_gmres_sparse", (DL_FUNC) &_Rlinsolve_single_gmres_sparse, 7}, {"_Rlinsolve_single_qmr", (DL_FUNC) &_Rlinsolve_single_qmr, 6}, {"_Rlinsolve_single_qmr_sparse", (DL_FUNC) &_Rlinsolve_single_qmr_sparse, 8}, {"_Rlinsolve_single_gs", (DL_FUNC) &_Rlinsolve_single_gs, 6}, {"_Rlinsolve_single_gs_sparse", (DL_FUNC) &_Rlinsolve_single_gs_sparse, 6}, {"_Rlinsolve_single_jacobi", (DL_FUNC) &_Rlinsolve_single_jacobi, 6}, {"_Rlinsolve_single_jacobi_sparse", (DL_FUNC) &_Rlinsolve_single_jacobi_sparse, 6}, {"_Rlinsolve_single_sor", (DL_FUNC) &_Rlinsolve_single_sor, 6}, {"_Rlinsolve_single_sor_sparse", (DL_FUNC) &_Rlinsolve_single_sor_sparse, 6}, {"_Rlinsolve_single_ssor", (DL_FUNC) &_Rlinsolve_single_ssor, 6}, {"_Rlinsolve_single_ssor_sparse", (DL_FUNC) &_Rlinsolve_single_ssor_sparse, 6}, {NULL, NULL, 0} }; RcppExport void R_init_Rlinsolve(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } Rlinsolve/src/krylov_bicgstab.cpp0000644000176200001440000001272215063666222016722 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Krylov Iterative Solver 3-1. Biconjugate Gradient Stabilized method // From NETLIB : http://www.netlib.org/templates/matlab//bicgstab.m //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.bicgstab.single)]] Rcpp::List single_bicgstab(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M){ // 1-1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown rho=0; -2 breakdown omega=0; // 1-2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ beta = (rho/rho_1)*(alpha/omega); p = r+beta*(p-omega*v); } else { p = r; } p_hat = solve(M,p); v = A*p_hat; alpha = rho/(dot(r_tld,v)); s = r - alpha*v; if (norm(s)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 3-2. Biconjugate Gradient Stabilized method : sprase way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.bicgstab.single.sparse)]] Rcpp::List single_bicgstab_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M){ // 1-1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown rho=0; -2 breakdown omega=0; // 1-2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ beta = (rho/rho_1)*(alpha/omega); p = r+beta*(p-omega*v); } else { p = r; } p_hat = spsolve(M,p,"lapack"); v = A*p_hat; alpha = rho/(dot(r_tld,v)); s = r - alpha*v; if (norm(s)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/src/krylov_cg.cpp0000644000176200001440000000760615063666222015542 0ustar liggesusers#include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Krylov Iterative Solver 1-1. Conjugate Gradient //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.cg.single)]] Rcpp::List single_cg(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M){ // 1-1. parameter settings const int n = A.n_cols; int iter=0; int flag=0; // 0 found; 1 no convergence // 1-2. pre-iteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vector beta = rho/rho_1; p = z+beta*p; } else { p = z; } q = A*p; alpha = rho/dot(p,q); x = x+alpha*p; // update approximation vector r = r-alpha*q; // compute residual error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error<=reltol){// check convergence break; } rho_1 = rho; iter += 1; } if (error>reltol){ flag = 1; } // 1-4. return outputs List res; res["x"] = x; res["iter"] = iter; if (iter>=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 1-2. Conjugate Gradient : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.cg.single.sparse)]] Rcpp::List single_cg_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M){ // 1-1. parameter settings const int n = A.n_cols; int iter=0; int flag=0; // 0 found; 1 no convergence // 1-2. pre-iteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vector beta = rho/rho_1; p = z+beta*p; } else { p = z; } q = A*p; alpha = rho/dot(p,q); x = x+alpha*p; // update approximation vector r = r-alpha*q; // compute residual error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error<=reltol){// check convergence break; } rho_1 = rho; iter += 1; } if (error>reltol){ flag = 1; } // 1-4. return outputs List res; res["x"] = x; res["iter"] = iter; if (iter>=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/src/krylov_cgs.cpp0000644000176200001440000001105015063666222015711 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Krylov Iterative Solver 4-1. Conjugate Gradient Squared //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.cgs.single)]] Rcpp::List single_cgs(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M){ // 1-1. parameter settings const int n = A.n_cols; int iter=0; int flag=0; // 0 found; 1 no convergence // 1-2. pre-iteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vectors beta = rho/rho_1; u = r+beta*q; p = u+beta*(q+beta*p); } else { u = r; p = u; } p_hat = solve(M,p); v_hat = A*p_hat; // adjusting scalars alpha = rho/dot(r_tld,v_hat); q = u-alpha*v_hat; u_hat = solve(M,u+q); x = x+alpha*u_hat; r = r-alpha*A*u_hat; error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error <= reltol){ break; } rho_1 = rho; iter += 1; } if (error <= reltol){ flag = 0; } else if (rho==0.0){ flag = -1; } else { flag = 1; } // 1-4. return outputs List res; res["x"] = x; res["iter"] = iter; if (iter>=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 4-2. Conjugate Gradient Squared : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.cgs.single.sparse)]] Rcpp::List single_cgs_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M){ // 1-1. parameter settings const int n = A.n_cols; int iter=0; int flag=0; // 0 found; 1 no convergence // 1-2. pre-iteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vectors beta = rho/rho_1; u = r+beta*q; p = u+beta*(q+beta*p); } else { u = r; p = u; } p_hat = spsolve(M,p,"lapack"); v_hat = A*p_hat; // adjusting scalars alpha = rho/dot(r_tld,v_hat); q = u-alpha*v_hat; u_hat = spsolve(M,u+q,"lapack"); x = x+alpha*u_hat; r = r-alpha*A*u_hat; error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error <= reltol){ break; } rho_1 = rho; iter += 1; } if (error <= reltol){ flag = 0; } else if (rho==0.0){ flag = -1; } else { flag = 1; } // 1-4. return outputs List res; res["x"] = x; res["iter"] = iter; if (iter>=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/src/method_gs.cpp0000644000176200001440000001074015063666222015505 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Basic Iterative Solver 2-1. Gauss-Seidel Method //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.gs.single)]] Rcpp::List single_gs(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const int dflagval){ // 1. seperate terms vec d = diagvec(A); mat D = diagmat(d); mat E = -trimatl(A,-1); // omit diagonal for lower mat F = -trimatu(A, 1); // omit diagonal for upper // 2. get parameters and set ready int n = A.n_rows; arma::colvec xold = xinit; if (norm(b-A*xinit)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } //------------------------------------------------------------------------------ // Basic Iterative Solver 2-2. Gauss-Seidel Method : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.gs.single.sparse)]] Rcpp::List single_gs_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const int dflagval){ // 1. seperate terms int n = A.n_rows; arma::sp_mat D = diagmat(A); arma::sp_mat E(n,n); for (int i=1;i=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } Rlinsolve/src/Makevars.win0000644000176200001440000000017715063666246015331 0ustar liggesusers ## optional PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) Rlinsolve/src/krylov_cheby.cpp0000644000176200001440000000752215063666222016240 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Krylov Iterative Solver 6-1. Chebyshev //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.cheby.single)]] Rcpp::List single_cheby(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, arma::mat& M, const double eigmax, const double eigmin){ // 1-1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown // 1-2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ beta = pow(c*alpha/2.0,2); alpha= 1.0/(d-beta); p = z+beta*p; } else { p = z; alpha = 2.0/d; } x = x + alpha*p; // update approximation r = r-alpha*A*p; // update residual error = norm(r)/bnrm2; if (error<=reltol){ // check convergence break; } iter += 1; } if (error>reltol){ flag = 1; } // 1-4. return outputs List res; res["x"] = x; res["iter"] = iter; if (iter>=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 6-2. Chebyshev : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.cheby.single.sparse)]] Rcpp::List single_cheby_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, arma::sp_mat M, const double eigmax, const double eigmin){ // 1-1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown // 1-2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ beta = pow(c*alpha/2.0,2); alpha= 1.0/(d-beta); p = z+beta*p; } else { p = z; alpha = 2.0/d; } x = x + alpha*p; // update approximation r = r-alpha*A*p; // update residual error = norm(r)/bnrm2; if (error<=reltol){ // check convergence break; } iter += 1; } if (error>reltol){ flag = 1; } // 1-4. return outputs List res; res["x"] = x; res["iter"] = iter; if (iter>=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/src/krylov_qmr.cpp0000644000176200001440000001727515063666222015753 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Krylov Iterative Solver 5. QMR //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.qmr.single)]] Rcpp::List single_qmr(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M){ // 1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown // 2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } // 3. error preparation arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vectors p = y_tld - (xi*delta/ep)*p; q = z_tld - (rho*delta/ep)*q; } else { p = y_tld; q = z_tld; } p_tld = A*p; ep = dot(q,p_tld); if (ep==0.0){ break; } beta = ep/delta; if (beta==0.0){ break; } v_tld = p_tld - beta*v; y = solve(M1, v_tld); rho_1 = rho; rho = norm(y); w_tld = (A.t()*q) - (beta*w); z = solve(M2.t(), w_tld); xi = norm(z); gamma_1 = gamma; theta_1 = theta; theta = rho/(gamma_1*beta); gamma = 1.0/sqrt(1.0+(theta*theta)); if (gamma==0.0){ break; } eta = -eta*rho_1*(gamma*gamma)/(beta*(gamma_1*gamma_1)); if (iter>0){ // compute adjustment d = eta*p + ((pow(theta_1*gamma,2))*d); s = eta*p_tld + ((pow(theta_1*gamma,2))*s); } else { d = eta*p; s = eta*p_tld; } x = x + d; // update approximation r = r - s; // update residual error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 5. QMR : Spasre Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.qmr.single.sparse)]] Rcpp::List single_qmr_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M, const arma::sp_mat M1, const arma::sp_mat M2){ // 1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown // 2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } // 3. error preparation arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vectors p = y_tld - (xi*delta/ep)*p; q = z_tld - (rho*delta/ep)*q; } else { p = y_tld; q = z_tld; } p_tld = A*p; ep = dot(q,p_tld); if (ep==0.0){ break; } beta = ep/delta; if (beta==0.0){ break; } v_tld = p_tld - beta*v; y = spsolve(M1, v_tld,"lapack"); rho_1 = rho; rho = norm(y); w_tld = (A.t()*q) - (beta*w); z = spsolve(M2.t(), w_tld,"lapack"); xi = norm(z); gamma_1 = gamma; theta_1 = theta; theta = rho/(gamma_1*beta); gamma = 1.0/sqrt(1.0+(theta*theta)); if (gamma==0.0){ break; } eta = -eta*rho_1*(gamma*gamma)/(beta*(gamma_1*gamma_1)); if (iter>0){ // compute adjustment d = eta*p + ((pow(theta_1*gamma,2))*d); s = eta*p_tld + ((pow(theta_1*gamma,2))*s); } else { d = eta*p; s = eta*p_tld; } x = x + d; // update approximation r = r - s; // update residual error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/src/method_jacobi.cpp0000644000176200001440000000632215063666222016324 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Basic Iterative Solver 1-1. Jacobi Method //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.jacobi.single)]] Rcpp::List single_jacobi(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const double weight){ // 1. seperate terms int n = A.n_rows; arma::mat Dinv(n,n,fill::zeros); for (int it=0;it=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } //------------------------------------------------------------------------------ // Basic Iterative Solver 1-2. Jacobi Method : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.jacobi.single.sparse)]] Rcpp::List single_jacobi_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const double weight){ // 1. seperate terms const int n = A.n_rows; arma::sp_mat Dinv(n,n); for (int i=0;i=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } Rlinsolve/src/krylov_gmres.cpp0000644000176200001440000001467315063666222016270 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; // Auxliary : Givens rotation matrix parameters for a and b arma::vec rotmat(double a, double b){ double c, s, temp; if (b==0.0){ c = 1.0; s = 0.0; } else if (std::pow(b,2.0)>std::pow(a,2.0)){ temp = a/b; s = 1.0/std::sqrt(static_cast(1.0+std::pow(temp,2))); c = temp*s; } else { temp = b/a; c = 1.0/std::sqrt(static_cast(1.0+std::pow(temp,2.0))); s = temp*c; } arma::vec res(2,fill::zeros); res(0) = c; res(1) = s; return(res); } //------------------------------------------------------------------------------ // Krylov Iterative Solver 7-1. GMRES //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.gmres.single)]] Rcpp::List single_gmres(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, arma::mat& M, const int restrt){ // 1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; // 2. other basics double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 7-2. GMRES : a sparse way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.gmres.single.sparse)]] Rcpp::List single_gmres_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, arma::sp_mat M, const int restrt){ // 1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; // 2. other basics double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/src/Makevars0000644000176200001440000000017715063666240014527 0ustar liggesusers ## optional PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) Rlinsolve/src/method_ssor.cpp0000644000176200001440000000762615063666222016073 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Basic Iterative Solver 4-1. SSOR //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.ssor.single)]] Rcpp::List single_ssor(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const double w){ // 1. seperate terms vec d = diagvec(A); mat D = diagmat(d); mat L = trimatl(A,-1); // omit diagonal for lower mat U = trimatu(A, 1); // omit diagonal for upper // 2. get parameters and set ready int n = A.n_rows; arma::colvec xold = xinit; if (norm(b-A*xinit)=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } //------------------------------------------------------------------------------ // Basic Iterative Solver 4-2. SSOR : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.ssor.single.sparse)]] Rcpp::List single_ssor_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const double w){ // 1. seperate terms int n = A.n_rows; arma::sp_mat D = diagmat(A); arma::sp_mat L(n,n); for (int i=1;i=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } return res; } Rlinsolve/src/krylov_bicg.cpp0000644000176200001440000001121715063666222016046 0ustar liggesusers#define ARMA_DONT_PRINT_ERRORS #include "RcppArmadillo.h" // [[Rcpp::depends(RcppArmadillo)]] using namespace Rcpp; using namespace arma; //------------------------------------------------------------------------------ // Krylov Iterative Solver 2-1. Biconjugate Gradient //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.bicg.single)]] Rcpp::List single_bicg(const arma::mat& A, const arma::colvec& b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::mat& M){ // 1-1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown // 1-2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vectors beta = rho/rho_1; p = z+beta*p; p_tld = z_tld+beta*p_tld; } else { p = z; p_tld = z_tld; } q = A*p; // compute residual pair q_tld = A.t()*p_tld; alpha = rho/dot(p_tld,q); x = x+alpha*p; r = r-alpha*q; r_tld = r_tld - alpha*q_tld; error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } //------------------------------------------------------------------------------ // Krylov Iterative Solver 2-2. Biconjugate Gradient : Sparse Way //------------------------------------------------------------------------------ //' @keywords internal //' @noRd // [[Rcpp::export(linsolve.bicg.single.sparse)]] Rcpp::List single_bicg_sparse(const arma::sp_mat A, const arma::sp_mat b, arma::colvec& xinit, const double reltol, const int maxiter, const arma::sp_mat M){ // 1-1. parameter settings int n = A.n_rows; int iter=0; int flag=0; // 0 found; 1 no cvgt; -1 breakdown // 1-2. Preiteration double bnrm2 = norm(b); if (bnrm2==0){ bnrm2=1.0; } arma::colvec x = xinit; if (norm(b-A*xinit)0){ // direction vectors beta = rho/rho_1; p = z+beta*p; p_tld = z_tld+beta*p_tld; } else { p = z; p_tld = z_tld; } q = A*p; // compute residual pair q_tld = A.t()*p_tld; alpha = rho/dot(p_tld,q); x = x+alpha*p; r = r-alpha*q; r_tld = r_tld - alpha*q_tld; error = norm(r)/bnrm2; if (iter<(maxiter-1)){ errors(iter+1) = error; } if (error=maxiter){ res["errors"] = errors; } else { arma::vec newerrors = errors.subvec(0,iter); res["errors"] = newerrors; } res["flag"] = flag; return res; } Rlinsolve/NAMESPACE0000644000176200001440000000066615063666222013466 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(aux.fisch) export(lsolve.bicg) export(lsolve.bicgstab) export(lsolve.cg) export(lsolve.cgs) export(lsolve.cheby) export(lsolve.gmres) export(lsolve.gs) export(lsolve.jacobi) export(lsolve.qmr) export(lsolve.sor) export(lsolve.ssor) import(Matrix) import(Rdpack) importFrom(Rcpp,evalCpp) importFrom(stats,rnorm) importFrom(utils,packageVersion) useDynLib(Rlinsolve, .registration=TRUE) Rlinsolve/LICENSE0000644000176200001440000000005715063666222013246 0ustar liggesusersYEAR: 2021 COPYRIGHT HOLDER: Rlinsolve authors Rlinsolve/NEWS.md0000644000176200001440000000035115063666222013334 0ustar liggesusers# Rlinsolve 0.3.2 * Fixed CRAN error. # Rlinsolve 0.3.1 * Added a `NEWS.md` file to track changes to the package. * Partial support for bigmemory is dropped due to its instability. We expect it to be running smooth in the future. Rlinsolve/inst/0000755000176200001440000000000015063666222013214 5ustar liggesusersRlinsolve/inst/REFERENCES.bib0000644000176200001440000000734515063666222015324 0ustar liggesusers @incollection{watson_conjugate_1976, address = {Berlin, Heidelberg}, title = {Conjugate gradient methods for indefinite systems}, volume = {506}, isbn = {978-3-540-07610-0 978-3-540-38129-7}, booktitle = {Numerical {Analysis}}, publisher = {Springer Berlin Heidelberg}, author = {Fletcher, R.}, editor = {Watson, G. Alistair}, year = {1976}, pages = {73--89} } @article{voevodin_question_1983, title = {The question of non-self-adjoint extension of the conjugate gradients method is closed}, volume = {23}, issn = {00415553}, language = {en}, number = {2}, journal = {USSR Computational Mathematics and Mathematical Physics}, author = {Voevodin, V.V.}, month = jan, year = {1983}, pages = {143--144}, file = {[Voevodin.1983] The question of non-self-adjoint extension of the conjugate gradients method is.pdf:/home/kisung/Dropbox/V2. Applied Mathematics/P2. Numerical/S3. linsolve/[Voevodin.1983] The question of non-self-adjoint extension of the conjugate gradients method is.pdf:application/pdf} } @article{van_der_vorst_bi-cgstab:_1992, title = {Bi-{CGSTAB}: {A} {Fast} and {Smoothly} {Converging} {Variant} of {Bi}-{CG} for the {Solution} of {Nonsymmetric} {Linear} {Systems}}, volume = {13}, issn = {0196-5204, 2168-3417}, shorttitle = {Bi-{CGSTAB}}, language = {en}, number = {2}, journal = {SIAM Journal on Scientific and Statistical Computing}, author = {van der Vorst, H. A.}, month = mar, year = {1992}, pages = {631--644} } @book{saad_iterative_2003, address = {Philadelphia}, edition = {2nd ed}, title = {Iterative methods for sparse linear systems}, isbn = {978-0-89871-534-7}, publisher = {SIAM}, author = {Saad, Y.}, year = {2003}, keywords = {Differential equations, Partial, Iterative methods (Mathematics), Numerical solutions, Sparse matrices} } @article{hestenes_methods_1952, title = {Methods of conjugate gradients for solving linear systems}, volume = {49}, issn = {0091-0635}, language = {en}, number = {6}, journal = {Journal of Research of the National Bureau of Standards}, author = {Hestenes, M.R. and Stiefel, E.}, month = dec, year = {1952}, pages = {409} } @article{sonneveld_cgs_1989, title = {{CGS}, {A} {Fast} {Lanczos}-{Type} {Solver} for {Nonsymmetric} {Linear} systems}, volume = {10}, issn = {0196-5204, 2168-3417}, language = {en}, number = {1}, journal = {SIAM Journal on Scientific and Statistical Computing}, author = {Sonneveld, Peter}, month = jan, year = {1989}, pages = {36--52} } @article{gutknecht_chebyshev_2002, title = {The {Chebyshev} iteration revisited}, volume = {28}, issn = {01678191}, language = {en}, number = {2}, journal = {Parallel Computing}, author = {Gutknecht, Martin H. and Röllin, Stefan}, month = feb, year = {2002}, pages = {263--283} } @article{saad_gmres:_1986, title = {{GMRES}: {A} {Generalized} {Minimal} {Residual} {Algorithm} for {Solving} {Nonsymmetric} {Linear} {Systems}}, volume = {7}, issn = {0196-5204, 2168-3417}, shorttitle = {{GMRES}}, language = {en}, number = {3}, journal = {SIAM Journal on Scientific and Statistical Computing}, author = {Saad, Youcef and Schultz, Martin H.}, month = jul, year = {1986}, pages = {856--869} } @book{demmel_applied_1997, title = {Applied {Numerical} {Linear} {Algebra}}, isbn = {978-0-89871-389-3 978-1-61197-144-6}, language = {en}, publisher = {Society for Industrial and Applied Mathematics}, author = {Demmel, James W.}, month = jan, year = {1997} } @article{freund_qmr:_1991, title = {{QMR}: a quasi-minimal residual method for non-{Hermitian} linear systems}, volume = {60}, issn = {0029-599X, 0945-3245}, language = {en}, number = {1}, journal = {Numerische Mathematik}, author = {Freund, Roland W. and Nachtigal, No�l M.}, month = dec, year = {1991}, pages = {315--339} }Rlinsolve/build/0000755000176200001440000000000015063670767013347 5ustar liggesusersRlinsolve/build/partial.rdb0000644000176200001440000006205015063670767015477 0ustar liggesusersMpǶ&X~(Q"_ڢDDR2)$@RI[HJdEH}DP}蘘舎E׽m즷yϻS(Tȓ?_H/M/̓o Hǎ1G!{i8 YnjS.0%bU3+{vij̗RjB>زJy8`~Z~jm9/v-X]}UN%Wߺ4zOV[o E3G\ׯVsKrP @䗏m ٓ_8U-Pw\FO'_῜+ZNA5}y\5h+Ŝn!j?LT 'wr1oWɼ39ݭ;gӻ;wL3jr36;tʞ,ZPr]{r*Mf-xX B]>DRNoN%} PgH׎z[_Bd|c!pErl/˹ڶ]ZBdJdk.1;eN4vCm vJ97ĦGͣZ0v!aB+~_,Y̟o(:m'b:Xˉ)9ӚC*Py1IʅVq]*9 G`~@}j1G^2hv_[~Qh1 6;ͨ x7qn.'aсĹ,s9埒ʥ4J@H¤Λf.VEUNc<q0Dlz_`IA2g;gV;goj#~^=P^ryڕlٝĸy1^%WbH̋cmF`pu`Z}/p]sPt2Q#Gw1GxQdu#<Ĵuo,qיI7Bԭ?bJAp2vٱ*nn۪V '̌m;)}Gv#K` qw|X(}o'Zow`#T?^By1fM']m ˝u0\~kfu$Fy:=.n挖@gAL%68aa_8?#0K{ K!.`~An#~/mtg0hhf3f|[(mRL%yZjڹ'nAL E>5= kŪU5āUg>_D_GO(tӸ- ~o𴱿k+i{$EdGT2HaO1/ Xs VtV a\(U'Lٮ!.b~Ql~sb7ħ*qYAqK_cka%jٷR6-bn&g4d[3(70N} Pt[ @5pۧ`i%d݈ki<8n lg1?ޭ?E]1I7q.|In}=ڮmv64ٴ;;=Ϩw4MP,t`œܮYiwV_,&Xe_6A<Oy@D :*/b\2NF rq󤡛oT a7E;sRެ؎s\y{濆;+_Q?\wr( $վ{ݪlzoDa}f0BM'DD阆7@9'?Lx#o N.U(]G;2 ?Hn,1 &1!n(XޠS.`?xobH3IҸJ1yڋ_짗mR,uv@\t;-Q!'k_be 31wſbI5_돠P1I6K!t!vc< DFiV OaIO#(> &~t®Tʕ'J xay|0OzQ#EQP$zv\d0%-XFGV77'H^Dzb}*֢obo]*H7\^1 :*m8qi^ ,viJ+WED;;/pm u);K4oNO)xNpRC:7SS=g_sNa{7G0/\|eW9@mߖn# I3Ie0?%loP0k\*y{:F|gXBInauۉI3  g ^a,;9nU{&Lvvu3Y+AVvvܹ{ xob~UoGq|%xins/ynw6̀v o{y1`W]˗ %Tޔs9ogI/o6Ae"~+5⿆U޵+y۝pkSPҴ*ʠbRntqR\t1\q쾀sy ō +qA%PQ1Z_Ȝ{;WJh|]G]ZI3)$v!^ⷓCZaE}x7)t@O$Ge?uct*Q4ż (tK֝q 4gySf{?'T:{! iƭ " @0UT,r .;,pqT j@Y"=/Ub"TP~Az%A1)QSX==;P)W2Dl~W۩νJ~ܩZ=߱r/,J]nh{{pzh> O m7boFg.OיGkk/"=|?|\z_յWF;ЫoQqmJubڶ]ղзXܴSlcΖFb?MtX짩L9W{޳٧| ]Kf^`Ue{!a=4ܜ;L%si'l:=7IN*;iU_Hx`+p Iu;v."W?$>0fx:N? ',WNh*``[Pfo+bP[/Qj'+ǰ8߹?^%;0@S`'"ԁFt-/joǮkv-l*W/rt=Wavǭt.KjЗsI$N-ӻ2 _.WD&ҵ\/3| toRW\*{Nӿ{|5m_8loRD+E{ ,33 D1B :/:}0yl;+]xCGuklOp*#__ʰ]Xn+V_  }'2mõ-g:QnV͵[ňoft|$j:z*mB5EĀZhԍkM֜Qp{t\O C=u@֩#*ZU+; ٱsL eek-k}-bwnoY˟jVj­g}9MODծZ-׷iODWn oBQcnwޕ+6&ך8uϋrd׿k6rP掚'ynEhG]UrF1_(ל/N ~P.<_UFqq/} =ԺW*8М9ToƩ?ut.҆uF >l(_6m*<5n`wa7/q9vMFzgSL3Ŗe\.: k $DQغcO÷{>dm XP 2,??_t+.`yY![*{+wrɵLL:[VŞ\OKID̾UiFoH.6[ XtƷkH7cenGL~fTSzEok h??'?Q y''׳?uap: '˘LB(%&E=B}yp7zs4 5Z_ިtRuOUGhA'ח{~g=garZUD9?=nj{qjC[f+%&ê_ϙu`l]aC[}A<- tWF =o_~|5ZZ;񵿎5xQV`<~.ηZpœə;I=;ì~Mnŝ`9S_FW]_, }o᫅ 'rK3C?2LnviwtI8X(8xnY-1KB73J3G>lbZ:/g*4#+1ش9xUx8FZy<_wܳM{{Y*m?b?um+ңc 2[KN&ܒ7?ӴQglsXucRNxܢ gu\)T%xθOl2 GsW~?`?HjM#Ԛ[}(Nx)YCghpޖ.xӲZ$ ;aW7O>:8N #[ ɋNb?չy`/@LmCS 27o~'ȗsYBb7lk $ |J8wAi1hD փ/@gB t!SEk"ne(a`>x,ur F2P|?dYk$fp$qqE#Ae5vľlX!6K_]faOq\+ 88%~."X^{sBu#^ :oұ*m'Sw1^1Ԫf씟sDbgM];NMNbwLb0sˠf-?/ƩLq^ĸy1#D^ acvi1_ 2SaLPOE@> &" ]1I W"eZ7-u<Ĵmq*q.".bnw{.s1cdTCf.C܌cU 3cS}ZcDv#K` q-K 2g/1J/ 1WBq-[bЮY1I};,0 )柪_AqK_cka%AijKeVRfzxPߩ`|Gh(~ALi/ 'GD.~tP/aN.!uF]X/]| q2"OPtP[wFNrWЗ{0#ͯovƻU?n+=Ϩwj}FvD7A bM*@j4'Ac@h;t{ h!~Ϥӿcƾ>f"X#Pb'mt u_⧜b7MWrq1)D>GLb>).yc4X4%v:=ZybO0bˈgc$ &ՓhJט?Bo$y>Fx2#Zq0uHÌ`O"LV?=PG7w'1?ߏ$ R)WNnv} >׹ xay|0Oz~QQP$՞–(ё(ɫR#1P11rb>Q:dALVw/YpL=F]xl[u`7 wľ*Wha5̓&w.khކ /Ԙ h6qZ4oqNDfLJGw[v{a$0?&`I1i-S–|,b*o'Riǘ߲⭎w/P-(v/SS;;C@gAL}JxWb܍(GS|yPZWy׮m7?w i\E߉XڜRntqR\t1nX1%Nc@q#-P/0AK߬Z 0 [0_Q~ք)K>% u!2ҪIl~$uj;;Js' mߖ"!ȩ=4FO0(iiV$4|zL!)a>짗.:uqˀxױmGө=G3HdƐyӘ k&7ZQ%w8 ̉r ͞.M~N*u.n&ļKއj1e(g|PUn߃8OK#4aV?`67G|CSh`o8LMrW5bL7HjNVUH Unݪ^})!1>ˍKPm t$Nj`{ctcc/6tsNqV+W+t'պB JPdAhj;՘:&αM'Ϝx,bHnSIu(nI)0KjZс3%= b"QT*/ma v~#=?70:#3V^Dԟ z0_=oIFw;ЫoQ06;9ڶ]*@mig+V;[J4Ac2\yi)_suk)߷ߪUݲF琰{YznߝKsswtr6L$gycϞf^HԈ ^wcWR.2N.(^F-pBFo2+XCVsg?z/%\N=}2Gu&^Oݿ"YݫܙkB>>ؿEd^9{F' &zM0@#j6܍{cNǫ Q?K3mC AL ׁ9̓'cBf/0IYgj9w1Mx~\{VDk51ւo1h-*_f9sЙ$"))s/EVHJb/"S(i{1.&GZm/"/^‘+jV_' oW4i{OW5k{ v+Si"6̧PKx[ۋp_^1bE v2IZi^#gnNaq>_KR(8BiFїh{IRh&^DuDKV璬pY#Vۋh8M^8~ `n *׷d0%ы;%,M\ m/j{ -t-th%)P(aNR֗x/x'(.qk5^~ m/UNBK7EwY/[޵D]n+BnXlj"u񦱯xz?N9??jȚ^Q9^wLRSR?{n!Nc~Z ܉w`ت9N2cD? K̓za~M gĤ5lMU( ukÌ 5U 7`** VJkD۪S\S0> k(ab h!Dq3b10?@n5)TqMը4Q\#n5UcuQk:9DqMBkOk=V~5Q\>ףXdkIV\\T\kDqMDqt(I;JqMŖX5]ǏWF⚪I 4%k̿A7F⚤QX2k&$'2bdmQP\)k<`Et@ 5Gk?UPlqwQ<5b׈Rc4bmb3wJ*yYG<#V|M|nAM/kΙ5+6yyO|ڑeY`)xe b` Me"eFRޞ|a|c=4V2+Ud.4qXNg0/m#9 & vAd˂ poZ3de.fQZq'n.q /"b~U t #RPŽ^f@gAL J!H4_/E,rިϒܩb~ /c{| Nw"*8,_q 0XП=RTXBü̕z y̋e/0/NqeSg/1O:D&]5 }. ؏~ F bl`+8ء](> &ӶH iC2|z a>d^deg`/6&Mab:aIoa62[m XvrOeb,X?aAvjnH1/LH81Mxyݓq5\.\Pʏ ~l7}M>Gޏ}M+$ )a+\s9~ Ơ CJ6e^ྏ3Cok} Wă25& b*`qZSɚ%lc&JXܲS4K0iLALV)>BO Vܗ7:o35MAl@ilc6b5)RհV4(P @ 'RAr7^CCVs~5JLIG2?,hGF'cσ` ϴX;ѶN O& N2@#͗`JL)Q{P <_`SCv x,=@n@$.3gJTNa~J 6 anEk1aDNJT\U $RH'X5HLj r@:/D^UC)Q5PW(=0A@N:P4iiR 䟹jV VD@bҮHXxDOj]j ᆿbĪ 7M5 &eTuG(> &4w' M'-8_5PR(8BiFj їըJV Th&DuD5PV璬pY#V5h8M8sQDj `n *T׷Te0%jj ы;(XMj\ @:*PP 5BP Ej@D53R9uH5P[_FF'(j.qk5~ @UNB5P7P Ej9ɪz媁fJTMU' TUޡ[Fj ZUUAsk_?B1q [ @Euq@j0B5P8 D/>UҶ;Fj ѶTU|CƩ&h*Z+Q GE=[MJĸn4U T5@1MTn[5PXs{`jN7Q j&Fj gtMTr6j@YZU3:U;4Q T5Q $=NR The#V5Pc(jqM GP((iV(Lj*?8I~ŧX@Y[*T=caOx,aHnS5u͜4s&jr?9 85h=D֝︆`4kK hқ~윮?6[l"U=W,n,=]~QE0eLh۶oΑ@ʀ-[EF0[-6T'32 AL7 MTBVe("$R!W.}Wtpq!G\5pCԎj`đ]vGDSF j Yz~,]5Ij |@"DRU.Ue兌!ܩ0^1Q<14&'8yX]GT\(>"/n_̛V}gC{;Yv j`vI9St8@e#7b0t]Ddn@߰[m gRn`;  }aYnxh#L'^!n }Kd}@KAp_^AѠ'1n-1Ah,>tfۧ+/-AOV: t.G4,>`U@hSę7JttEO(t`nPI}#t׷d>Ӌe0%\e0ۧhAA*t5EAOAAUn 0F'(~n.TDݾeA@Я1Q}zMۧ˛Y1sœ?2[vDKq^ח1YlW@31̏)_Ewyڞݺ3G͠/N!V\)]{-Mo#Z'FnfYcn* 4E Xv!0$t w͈T\uAHՊDtc@@&Ѡj= 0BHW'0R}sEg#P|AL+iKsW"u`&%4$9Fq+ uGG*něF"PŁ8!E Ef(sĤѠD{RѠ$}=A\3Zl1c4(Qc$ &Փ!4%`" ſaQ hP܉<{'E U~ļˏ$MhP u@1BHGc~^GA bT@0%@ё W7+XFGw7 )gEALRzwt^h/-܁f^tJnۿ8>83Vsa`^0z2@([C ǐ +yZ}t_qNmMA߳;cZb`i̧Oc_jb b`)9̋?|{Big!p>Sıf1 8W+q!P qIv3QD+C@ DW`^bvei24B||ǣ!o#af .a~I~dZL@ r4[F|;8< wB׈CxSӷ{<- xg0w+Wmni]kjj D)#I.̓"Km%kO]B V=itYɈToA"crĎjSD O$Bc_"'/#i̓vET8"eJubJPLbq_-6ˁ rNҹg&@LVQ&AqUuʥB"_/F+^ 7JѮܵPܝWI IJb*@l"*i_C>?ԮZ!:x|hqPy]ŒUs zN$yw:`~d;ܚOB.f8h!a}r23JΦ2?KO'K [!{n ?(6)S6-ۻ Cv`͝MK &4BdiX\-!,{&e) Pڠ+Fe5bo'0ڨF{չ$)4\ֈ{#N؛ ~ =F؛.-$qbo[UboFT)a&boD/؛c-boVpPܒ+FX'T~잀boFh(~ALi{(qF0rbo؛.Tjbo؛.oj!F 7INTӷ*Kޤm{S4o!Ft!j4j!kh! @B7aH؛zU؛+DƺT5װGFP|7 j(>aĊqctLu_gc{,[؛NNm&bo&PZ7b!&}#[MŖX7]WF؛I0BMWboFabo;qT#s%ˏ1I#%bo17U5^8y7{؛h!&J QMWob$W_U\O n~s ,oᯩ3,$MK)lCiF` d^c_I)4ϔ+G4~)8*QRp]SB l)8".'IRpD[wP NVdZL-ERpB HW!'RpֈP|A5b_tRpf&GvFn)8"MRpDNd T)8"=Rpsਛ;.zzޕb$TjuNT, 3_#]ȎՌ[xPc(PQ}OGdm } )$+ o!;@LVQh3k6vec\qB6S 0om.Ut T|6S4u;LEP*R! vHlխ➹\&{*T Lařgsiгh'⑥PB}Yg2OWͯ˵ hݸ^-nd8ޝȂMnۏ&w΀4EF97/w3;N&gr7I r7䝩̸9KNϤ%J1I@ ~i?kkh5[Š~-?4y'M07aI ߀5;F ';4I& fwh!vӇ> db7g1VQs bQ`dnb:'ss ALry9+'MV4fvmc~+AC b"Z YN<ҴaI)ѴsiCVӆHJ ؅ sM~Q"sisQӆg㭸Nrʋ s؟FVb;ACMB9v j(}0"Lc&iہ?Ӎ!?-s!#حNCi=FbQw!19\~ b;GDvB0vv3ėFᆿAlG)b^V Z] bV7a)x)*7y1q[ @diX\ż#!,*b݈b;$b " b;D_&X 1BlGn#FmFl8~h b;:d0$pYdF؎ _GO(tPM'k]b;[54fzSd0%&'<؎&  b;D/V!̮!. b;b;@ SAlG _0Blh1b;@U5BC{ bMhQ(hb; ?:F\`)œT>YAlG[_FF'(~؎.J:&\A_1Z g;5+/!˛Y1}sj1AgFozL_vmvg5uub;fPbѥ5ۈ j4Db>s bM@fNnЇg= ԇL%-WIZ;@D`|ÈuP1I7 [ @Ek2:-FMD6H%Y$KFHpDT"Yg ,]4TUd oUdaJ#L ,E#L ,w@$K)|,U+"Ys R(Zd[dB$KRP")œ:$ʭ/#DtD$K"YZH_wB$KSM-Dth!%ɩdqQW5J$K*,E3|(HѥHh0a"Yh\PQH:, ,U V(HыHid+E:,U3ߐq"YFj(H.&@dJDD:1MET*PL,R5\!CMDk/$ +ć9],b="YZ$K'"Y"YzB$K.K ,b!%}_LHB-"YN¶R5h!+ɒ4 +|t]$KD~?SFH-J"Y1,UB$KGHh!%#Q$KWǰ-D"LH-~_Kt5_ec2VMVVNݥ]ل̚㩃y7-5D~ W1.#*w[5b[)̧Nb6ۚeFycXwǵim!0_&_kKpS\֖q(nĈڢ^s [kkmI9EZ[|.eQ D[wPkKVZV@֖h-Z[huZ[ k'X-ή.Yim"ҭETkI֖qE_EձbEM> l9*[̛p:E$1qp,i~ צsK(ThrB[5~hwBnƞ ٿɶ|wr0oVALuv/Yr[1,f نU] b:vq;ZEڞVpk4E _b$Ü]8[* ?hv"^e(2QEl^)lElI)QآsE5R-") [Db+l*WآRE%_aK8tEsXkQ{3>-M [3W [݊E ȕ:-n-> yňUn 5@L5 &i)l P|ALi0{$aqV -ΰ_aKR(8P"- [ mDah(l\.k*l IaKUo+zPE[ @5A\–V–9´PR4´P"zqWRkEX'T [F [hPؒ((lqF0)lrh<-]7QEc[ @5nFaKЯ;ʩ[(l [hPؒJ8}+f%mG–>6`*l]p(l5lU(l 1S\PR`X-^-A*QRi#Vah[u [g!tP|-]4Llɔ(l [)lu"b\7*lU& [D7֭j= 0BaKW'(l ^HaKW@ #Va _s& [ԧz8K–%[aKp=SaSQ[(l)eiE{:VRhe#VaCx'-TM"Z(l銠-$ hWRG7w'1?ߏ%kR–'uLaKGPQ-k/Z(l YaKWǰ-NҁGw bl$P+z}dZy -yⅱS)k*^ +uKVa]=Vm{\٫K?Mۂw%(mAΕݥ[A?8n9w- J3Wopy&0X%wŰFJm Zb^ݕ_1IZ`ٕU/lI"Ia#KmWc '{ڥ0=`H,49Rh*@OG jr`/ctM)hb)1m͑i B@) yo2"怟j6:xRM6~o!_Hm<^]{(r3iWZTm[j =phXy˖yq'n nnW3,4LiR_d! M6Be(Ԇa\,Bo N!_s3ۢ0KQ`Y?`l6o7oйWߠKz :z 1 yo^3vfL2^#P |pKnaLPETr/ájBhNp -d8t-d8th!!)P(aNP֗xo'( .-d8$A *n!á˛ZpBCS+ue8mP4ÇҚp]pp+á5lXAc؏_>A=dֈQOPc>w:nݙM&f;8zlTjfܜJ%gwاAIATJ  RA0x e"怟}TRhj@[~TRhG3d%G_}Q9YALolWG3H D={A$ 1hDqcJ64b,W s?*Py1u*0^ 0OjRSP8yZ{ &If|YBǪvG$Z턈',dR' f9sБŔ"))QNs@V9HJrb"1 DI t p@f,-%8bLPKta 0KI*I xڧ%Kt !]l]f]K ح^ Rz],[]Co4u + A@x,]>C|i4n+0t ".(yK<@L5 &iyTE P|ALiiɂT]3 aQ.F%&u G(m1BD] 1K }n;K!F(m]/-A@V%: t .K@4,]`U@h%P/]/'ALi* 8I7`.Ktz9 t 0PZ 0h4X.0h4>"'O]U+8(n 1Bzt@.P1B@U KkĤҠ.Pt .Ĉ;Q8#E*]`ۇ8k4rkV`"B@?As t tѸ-& / ](]UNKD&(~ALi* ZL*3 eGm eA@Y}8f4(_Ew% &] }2t TF.HYc0K @B,vXv!X_]3"o\o*GUX+X@&p(uur( kg#P|AL+|iKsVNs6@ce붏rxI(v#4oԶ8g0tI39bh&ۥ/sq'kF -qMP+1D )#oA7 b< SoxЅqNہgp*? .[~?S bGG{?Pw;C]Gc~^GA o}aJ nn`O,5v}&V9@r,`B &Vyk%qkU}6fn{/e7bU`TX~l*䶼}K.\߹*{V*hݵ+pB2a>Vک:޾cUʍu[nrwL0;)L8dq燚Uq܎wn꺶T~W:fmӝ[Tm.nY%ϊ=7)$(^/ot |0O]r {ؾ5'p=B2 v.r߿tu;{?MoUڽS.JĮngb$n u{ nWE^/1hru{p'ᗢEM{?GU]bJ 7@BWnqu{{on7WZk7[ja]e?_C=FR{tfō +I܂]t-K'(܅5J9ڥ)&kL֦׶Jm*1gGL{_ǮB!3G}j77wiՐSS;7S3wS3w>v V}]C7 yk(3+bjٯ>]x KOugQe8?zqӃyvY{?=4jq Ă>yI_'1aRlinsolve/man/0000755000176200001440000000000015063666442013016 5ustar liggesusersRlinsolve/man/basic_GS.Rd0000644000176200001440000000377315063666442014771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lsolve_GS.R \name{lsolve.gs} \alias{lsolve.gs} \title{Gauss-Seidel method} \usage{ lsolve.gs( A, B, xinit = NA, reltol = 1e-05, maxiter = 1000, adjsym = TRUE, verbose = TRUE ) } \arguments{ \item{A}{an \eqn{(m\times n)} dense or sparse matrix. See also \code{\link[Matrix]{sparseMatrix}}.} \item{B}{a vector of length \eqn{m} or an \eqn{(m\times k)} matrix (dense or sparse) for solving \eqn{k} systems simultaneously.} \item{xinit}{a length-\eqn{n} vector for initial starting point. \code{NA} to start from a random initial point near 0.} \item{reltol}{tolerance level for stopping iterations.} \item{maxiter}{maximum number of iterations allowed.} \item{adjsym}{a logical; \code{TRUE} to symmetrize the system by transforming the system into normal equation, \code{FALSE} otherwise.} \item{verbose}{a logical; \code{TRUE} to show progress of computation.} } \value{ a named list containing \describe{ \item{x}{solution; a vector of length \eqn{n} or a matrix of size \eqn{(n\times k)}.} \item{iter}{the number of iterations required.} \item{errors}{a vector of errors for stopping criterion.} } } \description{ Gauss-Seidel(GS) method is an iterative algorithm for solving a system of linear equations, with a decomposition \eqn{A = D+L+U} where \eqn{D} is a diagonal matrix and \eqn{L} and \eqn{U} are strictly lower/upper triangular matrix respectively. For a square matrix \eqn{A}, it is required to be diagonally dominant or symmetric and positive definite. For an overdetermined system where \code{nrow(A)>ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A)ncol(A)}, it is automatically transformed to the normal equation. Underdetermined system - \code{nrow(A). License: MIT + file LICENSE Encoding: UTF-8 Imports: Rcpp (>= 0.12.4), Matrix, Rdpack, stats, utils LinkingTo: Rcpp, RcppArmadillo RoxygenNote: 7.3.2 RdMacros: Rdpack NeedsCompilation: yes Packaged: 2025-09-21 03:33:12 UTC; kyou Author: Kisung You [aut, cre] (ORCID: ) Maintainer: Kisung You Repository: CRAN Date/Publication: 2025-09-22 05:10:56 UTC