corpcor/0000755000175100001440000000000013067644415011751 5ustar hornikuserscorpcor/NAMESPACE0000644000175100001440000000075012547164607013174 0ustar hornikusersexport( "cor.shrink", "cor2pcor", "cov.shrink", "crossprod.powcor.shrink", "decompose.cov", "decompose.invcov", "estimate.lambda", "estimate.lambda.var", "fast.svd", "invcor.shrink", "invcov.shrink", "is.positive.definite", "make.positive.definite", "mpower", "pcor.shrink", "pcor2cor", "powcor.shrink", "pseudoinverse", "pvar.shrink", "rank.condition", "rebuild.cov", "rebuild.invcov", "sm.index", "sm2vec", "var.shrink", "vec2sm", "wt.moments", "wt.scale", "wt.var" ) import("stats") corpcor/NEWS0000644000175100001440000001724613067473747012472 0ustar hornikusers RELEASE HISTORY OF THE "corpcor" PACKAGE Version 1.6.9 - fixed a bug that made it possible that in very rare cases the shrinkage intensity can become negative - DOIs for all references added Version 1.6.8 - import statements added required by R-devel Version 1.6.7 - change of maintainer email address Version 1.6.6 - is.positive.definite() and make.positive.definite() now use eigen() with option symmetric=TRUE, so that it works under R 3.0.0 (thanks to Roberto Ugoccioni for reporting this issue) Version 1.6.5 - License file removed - Dependencies updated Version 1.6.4 - estimate.lambda() now also works if the input data matrix has two columns (thanks to Manuela Hummel for reporting this bug) Version 1.6.3 - substantially faster estimate.lambda() for small sample size and large dimensions (new algorithm suggested by Miika Ahdesm\"aki) Version 1.6.2 - new public functions estimate.lambda() and estimate.lambda.var() returning the shrinkage intensities for correlation and variance shrinkage - some internal code reorganization Version 1.6.1 - NAMESPACE file added - small changes in de documentation Version 1.6.0 - collapse option removed from: powcor.shrink, cor.shrink, invcor.shrink, cov.shrink, invcov.shrink - default minimum R version changed to 2.10.0 - new function crossprod.powcor.shrink() to efficiently compute R_shrink^alpha y without the need to explicitly compute R_shrink^alpha Version 1.5.7 - the function mvr.shrink() has been removed (for a related function see the "care" R package). - mpower() now keeps row and column names. Version 1.5.6 - cor.shrink() now also works if the input data matrix only has a single column. Version 1.5.5 - a numerical problem with symmetry check in invcor.shrink() and related functions has been resolved (thanks to Gad Abraham). - following an idea by Miika Ahdesm\"aki the procedures for estimating the shrinkage intensities have been rewritten in pure R without employing any C code any more (w/o speed penalty!). Version 1.5.4 - mpower() now has an option to exclude nonzero eigenvalues and also checks whether the input matrix is symmetric. Version 1.5.3 - small corrections to pass checks for R version 2.10. - reference to Zuber and Strimmer (2009) added. Version 1.5.2 - small corrections in the help pages, to pass the more stringent checks on .Rd files introduced in R in January 2009. Version 1.5.1 - powcor.shrink() now collapses the identity matrix if alpha=0 and collapse=TRUE. - help page for powcor.shrink was revised. - package description was also revised. Version 1.5.0 - new function powcor.shrink() computes (very efficiently!) an arbitrary power of the correlation shrinkage matrix (i.e. R_shrink^alpha). - invcor.shrink() is now a special case powcor.shrink() with alpha=-1. - invcov.shrink() now also uses powcor.shrink(). - new mpower() utility function to estimate the matrix power of a real symmetric matrix. Version 1.4.8 - new "collapse" option in cor.shrink, cov.shrink, invcor.shrink, invov.shrink to allow memory savings when lambda equals 1. - to simplify code base two rarely used options were removed: "protect" and "scale.by" (wt.scale is now always done using "sd"). - package depends now on R 2.7.0. - documentation was polished. Version 1.4.7 - change of license from "GPL 2 or later", to "GPL 3 or later". Version 1.4.6 - following a suggestion (and a patch) by Nicola Soranzo internal big objects are now explicitly removed when they are not needed anymore. As a result, the package now needs less computer memory, and larger (partial) correlation matrices can be computed. Version 1.4.5 - when partial correlations are computed using pcor.shrink() the returned matrix now has the standardized partial variances (i.e. PVAR/VAR) attached under the attribute "spv". - updated references in the help pages Version 1.4.4 - the function wt.scale() is now *much* faster, especially for large p, due to using colSums() rather than apply() .. note that this indirectly speeds up most other functions in the corpcor package! - typos in the documtation were corrected and references updated Version 1.4.3 - the shrinkage target for the variance is now the median (previously, variances were shrunken towards the mean). - var.shrink now also has a"protect" argument. - limited translation shrinkage is now turned off by default (i.e. protect has value zero). Version 1.4.2 - limited translation estimator implemented for the shrinkage estimate of the correlation matrix. This prevents excessive component risk. - new functions for decomposing the covariance matrix and its inverse: decompose.cov(), decompose.invcov(), rebuild.invcov() - new function pvar.shrink() to estimate partial variance. - in the documentation the definition of partial variance and partial covariance are corrected (following Whittaker 1990) - the functions cov2pcov(), pcov2cov(), pcov.shrink() have been removed. - functions sm2vec(), vec2sm(), sm.index() back (from GeneTS) - is.positive.definite() checks for complex eigenvalues. Version 1.4.1: - fast.svd() now doesn't use any more the LAPACK routines DGESVD to compute the singular value decomposition (this routine is deprecated from R version 2.3.0) - weighted.var(), weighted.moments(), weighted.scale() are now called wt.var(), wt.moments(), wt.scale() Version 1.4.0: - New functions mvr.shrink() and mvr.predict() for multivariate shrinkage regression. - All shrinkage estimate now carry the class attribute "shrinkage. This allows for a more informative output via print.shrinkage() - Removed functions: sm2vec(), vec2sm(), sm.indexes() Version 1.3.1: - This versions fixes a bug present in "corpcor" version 1.3.0 and 1.2.0 but not in earlier versions. This bug leads to a (probably negligible) small bias in the computation of the optimal shrinkage intensity. - The functions cov.bagged(), cor.bagged(), and pcor.bagged() have been removed. - Typographical errors in the documentation were corrected. Version 1.3.0: - New function "var.shrink" to compute shrinkage estimates of variances (target: average empirical variances. - cov.shrink() and pcov.shrink() are now also based on shrunken variances. - Estimation of shrinkage intensities are now done in C. This greatly decreases the computational costs. - Options "check.eigenvalues" and "exact.inversion" have been removed in cor2pcor() and pcor2cor() - The functions have been modified so that data sets with zero-variance variables may also be analyzed (these will be in effect ignored in estimating correlation but taken into account when estimating variances). Version 1.2.0: - Greatly reduced memory and faster computations. - New code on fast inversion using Woodbury identity. - Consequently, pcor.shrink() is now much faster . - New functions for computation of weighted variances, weighted moments, and weighted rescaling. - All covariance etc. estimators now also have the option to supply data weights". - varcov() function removed (not necessary any more). - Several parts of documentation updated. - Juliane's Web address updated. Version 1.1.2: - Minor typos in documentation corrected. - From this version is.positive.definite() works with arbitrary matrix (previously it required symmetric matrix). Version 1.1.1: - Reference to shrinkage covariance paper is updated. Version 1.1: - cor.shrink() is now the central estimator, and cov.shrink is derived. Version 1.0: - First stand-alone release (20 August 2005). This package contains various functions shrinkage estimation of (partial) correlation and covariance. Prior to release in this package the functions were part of the GeneTS package. corpcor/R/0000755000175100001440000000000013067470754012155 5ustar hornikuserscorpcor/R/mpower.R0000644000175100001440000000322112371445250013575 0ustar hornikusers### mpower.R (2010-01-15) ### ### Compute the Power of a Real Symmetric Matrix ### ### Copyright 2008-10 Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # compute m^alpha where m is a symmetric matrix mpower = function(m, alpha, pseudo=FALSE, tol) { if( any( abs(m-t(m)) > 100*.Machine$double.eps ) ) stop("Input matrix is not symmetric!") em = eigen(m, symmetric = TRUE) eval = em$values # set small eigenvalues to exactly zero if( missing(tol) ) tol = max(dim(m))*max(abs(eval))*.Machine$double.eps eval[abs(eval) <= tol] = 0 if (pseudo) # use only the nonzero eigenvalues { idx = (eval != 0) } else # use all eigenvalues { idx = (1:length(eval)) } e2 = eval[idx]^alpha ma = em$vectors[,idx, drop=FALSE] %*% tcrossprod(diag(e2, nrow=length(e2)), em$vectors[,idx, drop=FALSE]) rownames(ma) = rownames(m) colnames(ma) = colnames(m) return(ma) } corpcor/R/rebuild.cov.R0000644000175100001440000000341112371445250014501 0ustar hornikusers### rebuild.cov.R (2006-05-25) ### ### Rebuild and Decompose (Inverse) Covariance Matrix ### ### ### Copyright 2003-06 Korbinian Strimmer ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # rebuild covariance matrix from correlations (r) and variances (v) rebuild.cov = function(r, v) { if ( any( v < 0) ) stop("Negative variance encountered!") sd = sqrt(v) m = sweep(sweep(r, 1, sd, "*"), 2, sd, "*") return(m) } # decompose covariance matrix into correlations and variances decompose.cov = function(m) { v = diag(m) r = cov2cor(m) return( list(r=r, v=v) ) } # rebuild precision matrix from partial correlations (pr) and partial variances (pv) rebuild.invcov = function(pr, pv) { if ( any( pv < 0) ) stop("Negative partial variance encountered!") ipsd = sqrt(1/pv) m = -sweep(sweep(pr, 1, ipsd, "*"), 2, ipsd, "*") diag(m) = -diag(m) return(m) } # decompose precision matrix into partial correlations and partial variances decompose.invcov = function(m) { pv = 1/diag(m) m = -m diag(m) = -diag(m) pr = cov2cor(m) return( list(pr=pr, pv=pv) ) } corpcor/R/rank.condition.R0000644000175100001440000000554312371445250015215 0ustar hornikusers### condition.R (2013-5-15) ### ### Rank, condition, and positive definiteness of a matrix ### ### Copyright 2003-13 Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # checks whether a matrix is positive definite is.positive.definite = function (m, tol, method=c("eigen", "chol")) { method = match.arg(method) if (!is.matrix(m)) m = as.matrix(m) if (method=="eigen") { eval = eigen(m, only.values = TRUE, symmetric=TRUE)$values if (is.complex( eval )) { warning("Input matrix has complex eigenvalues!") return(FALSE) } if( missing(tol) ) tol = max(dim(m))*max(abs(eval))*.Machine$double.eps if (sum(eval > tol) == length(eval)) return(TRUE) else return(FALSE) } if (method=="chol") { val = try(chol(m), silent=TRUE) if (class(val) == "try-error") return(FALSE) else return(TRUE) } } # Method by Higham 1988 make.positive.definite = function(m, tol) { if (!is.matrix(m)) m = as.matrix(m) d = dim(m)[1] if ( dim(m)[2] != d ) stop("Input matrix is not square!") es = eigen(m, symmetric=TRUE) esv = es$values if (missing(tol)) tol = d*max(abs(esv))*.Machine$double.eps delta = 2*tol # factor to is just to make sure the resulting # matrix passes all numerical tests of positive definiteness tau = pmax(0, delta - esv) dm = es$vectors %*% diag(tau, d) %*% t(es$vectors) #print(max(DA)) #print(esv[1]/delta) return( m + dm ) } # rank and condition of a matrix rank.condition = function (m, tol) { d = svd(m, nv=0, nu=0)$d # compute only singular values max.d = d[1] min.d = d[length(d)] if( missing(tol) ) tol = max(dim(m))*max.d*.Machine$double.eps r = sum(d > tol) # rank: number of singular values larger than tol if (r < min(dim(m)) ) min.d = 0 # if matrix is singular then set the smallest # singular value to 0, and hence condition = INF c = max.d/min.d return(list(rank = r, condition = c, tol=tol)) } corpcor/R/wt.scale.R0000644000175100001440000000464512371445250014017 0ustar hornikusers### wt.scale.R (2008-10-14) ### ### Weighted Expectations and Variances ### ### ### Copyright 2006-2008 Korbinian Strimmer ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # in all the following functions, # w is a vector of weights with sum(w)=1 # mean and variance # this exists already in R #weighted.mean = function(xvec, w) #{ # return( sum(w*xvec) ) #} wt.var = function(xvec, w) { w = pvt.check.w(w, length(xvec)) # bias correction factor h1 = 1/(1-sum(w*w)) # for w=1/n this equals the usual h1=n/(n-1) xc = xvec-weighted.mean(xvec, w) s2 = h1*weighted.mean(xc*xc, w) return( s2 ) } wt.moments = function(x, w) { x = as.matrix(x) w = pvt.check.w(w, nrow(x)) # bias correction factor h1 = 1/(1-sum(w*w)) # for w=1/n this equals the usual h1=n/(n-1) # m = apply(x, 2, weighted.mean, w=w) m = colSums(w*x) # same as above, but much faster # v = apply(x, 2, wt.var, w=w) v = h1*(colSums(w*x^2)-m^2) # same as above, but much faster # set small values of variance exactly to zero v[v < .Machine$double.eps] = 0 return( list(mean=m, var=v) ) } # scale using the weights wt.scale = function(x, w, center=TRUE, scale=TRUE) { x = as.matrix(x) w = pvt.check.w(w, nrow(x)) # compute column means and variances wm = wt.moments(x, w) if (center==TRUE) { x = sweep(x, 2, wm$mean, "-") attr(x, "scaled:center") = wm$mean } if (scale==TRUE) { sc = sqrt(wm$var) x = sweep(x, 2, sc, "/") attr(x, "scaled:scale") = sc zeros = (sc == 0.0) x[,zeros] = 0 if (any(zeros)) { warning(paste(sum(zeros), "instances of variables with zero scale detected!"), call. = FALSE) } } return(x) } corpcor/R/smtools.R0000644000175100001440000000426512371445250013775 0ustar hornikusers### smtools.R (2006-06-02) ### ### Convert symmetric matrix to vector and back ### ### Copyright 2003-06 Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # convert symmetric matrix to vector sm2vec = function(m, diag = FALSE) { return( as.vector(m[lower.tri(m, diag)]) ) } # corresponding indices sm.index = function(m, diag = FALSE) { m.dim = length(diag(m)) if (diag == TRUE) num.entries = m.dim*(m.dim+1)/2 else num.entries = m.dim*(m.dim-1)/2 index1 = rep(NA, num.entries ) index2 = rep(NA, num.entries ) if (diag == TRUE) delta = 0 else delta = 1 z = 1 for (i in 1:(m.dim-delta)) for (j in (i+delta):m.dim) { index1[z] = i index2[z] = j z = z+1 } return( cbind(index1, index2) ) } # convert vector to symmetric matrix # # note: if diag=FALSE then the diagonal will consist of NAs # vec2sm = function(vec, diag = FALSE, order = NULL) { # dimension of matrix n = (sqrt(1+8*length(vec))+1)/2 if (diag == TRUE) n = n-1 if ( ceiling(n) != floor(n) ) stop("Length of vector incompatible with symmetric matrix") # fill lower triangle of matrix m = matrix(NA, nrow=n, ncol=n) lo = lower.tri(m, diag) if (is.null(order)) { m[lo] = vec } else { # sort vector according to order vec.in.order = rep(NA, length(order)) vec.in.order[order] = vec m[lo] = vec.in.order } # symmetrize for (i in 1:(n-1)) for (j in (i+1):n) m[i, j] = m[j, i] return( m ) } corpcor/R/pvt.svar.R0000644000175100001440000000350012371445250014047 0ustar hornikusers### pvt.svar.R (2012-01-21) ### ### Non-public function to compute variance shrinkage estimator ### ### ### Copyright 2005-12 Rainer Opgen-Rhein and Korbinian Strimmer ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # function to compute shrinkage variance vector # - x: data matrix, # - w: data weights pvt.svar = function(x, lambda.var, w, verbose) { # determine correlation shrinkage intensity if (missing(lambda.var)) { lambda.var = estimate.lambda.var(x, w, verbose) lambda.var.estimated=TRUE } else { if (lambda.var < 0) lambda.var = 0 if (lambda.var > 1) lambda.var = 1 if (verbose) { cat(paste("Specified shrinkage intensity lambda.var (variance vector):", round(lambda.var, 4), "\n")) } lambda.var.estimated=FALSE } # compute empirical variances v = wt.moments(x, w)$var # compute shrinkage target target = median(v) # shrinkage estimate vs = lambda.var*target + (1-lambda.var)*v attr(vs, "lambda.var") = lambda.var attr(vs, "lambda.var.estimated") = lambda.var.estimated attr(vs, "class") = "shrinkage" if (verbose) cat("\n") return(vs) } corpcor/R/pvt.cppowscor.R0000644000175100001440000000661212371445250015122 0ustar hornikusers### pvt.cppowscor.R (2012-01-21) ### ### Efficient computation of crossprod(R^alpha, y) ### ### Copyright 2011-2012 A. Pedro Duarte Silva, Verena Zuber, and Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA ##### internal functions ###### # this procedure exploits a special identity to efficiently # compute the crossprod of matrix power of the correlation shrinkage estimator with y # computes R_shrink^alpha %*% y pvt.cppowscor = function(x, y, alpha, lambda, w, verbose) { # determine correlation shrinkage intensity if (missing(lambda)) { lambda = estimate.lambda(x, w, verbose) lambda.estimated=TRUE } else { if (lambda < 0) lambda = 0 if (lambda > 1) lambda = 1 if (verbose) { cat(paste("Specified shrinkage intensity lambda (correlation matrix):", round(lambda, 4), "\n")) } lambda.estimated=FALSE } ##### n = nrow(x) w = pvt.check.w(w, n) # standardize input matrix by standard deviations xs = wt.scale(x, w, center=TRUE, scale=TRUE) # standardize data matrix # bias correction factor h1 = 1/(1-sum(w*w)) # for w=1/n this equals the usual h1=n/(n-1) p = ncol(xs) if (lambda == 1 | alpha == 0) # result in both cases R is the identity matrix { cp.powr = y # return y } else { # number of zero-variance variables zeros = (attr(xs, "scaled:scale")==0.0) svdxs = fast.svd(xs) m = length(svdxs$d) # rank of xs UTWU = t(svdxs$u) %*% sweep(svdxs$u, 1, w, "*") # t(U) %*% diag(w) %*% U C = sweep(sweep(UTWU, 1, svdxs$d, "*"), 2, svdxs$d, "*") # D %*% UTWU %*% D C = (1-lambda) * h1 * C C = (C + t(C))/2 # symmetrize for numerical reasons (mpower() checks symmetry) # note: C is of size m x m, and diagonal if w=1/n if (lambda==0.0) # use eigenvalue decomposition computing the matrix power { if (m < p-sum(zeros)) warning(paste("Estimated correlation matrix doesn't have full rank", "- pseudoinverse used for inversion."), call. = FALSE) cp.powr = svdxs$v %*% (mpower(C, alpha) %*% crossprod( svdxs$v, y)) } else # use a special identity for computing the matrix power { F = diag(m) - mpower(C/lambda + diag(m), alpha) cp.powr = (y - svdxs$v %*% (F %*% crossprod(svdxs$v, y) ))*(lambda)^alpha } # set all diagonal entries in R_shrink corresponding to zero-variance variables to 1 cp.powr[zeros,] = y[zeros,] } rownames(cp.powr) = colnames(xs) colnames(cp.powr) = colnames(y) rm(xs) attr(cp.powr, "lambda") = lambda attr(cp.powr, "lambda.estimated") = lambda.estimated attr(cp.powr, "class") = "shrinkage" if (verbose) cat("\n") return( cp.powr ) } corpcor/R/partial.R0000644000175100001440000000437612371445250013734 0ustar hornikusers### partial.R (2008-11-14) ### ### Partial Correlation and Partial Variance ### ### ### Copyright 2003-2008 Juliane Schaefer and Korbinian Strimmer ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # # partial correlation matrix # # input: covariance matrix or correlation matrix # ouput: partial correlation matrix # cor2pcor = function(m, tol) { # invert, then negate off-diagonal entries m = -pseudoinverse(m, tol=tol) diag(m) = -diag(m) # standardize and return return(cov2cor(m)) } # # backtransformation to correlation matrix # # input: partial correlation matrix # ouput: correlation matrix pcor2cor = function(m, tol) { # negate off-diagonal entries, then invert m = -m diag(m) = -diag(m) m = pseudoinverse(m, tol=tol) # standardize and return return(cov2cor(m)) } ######################################################## # partial correlation pcor.shrink = function(x, lambda, w, verbose=TRUE) { pc = -invcor.shrink(x, lambda, w, verbose=verbose) diag(pc) = -diag(pc) spv = 1/diag(pc) # standardized partial variances (i.e. pvar/var) pc = cov2cor(pc) # partial correlations attr(pc, "spv") = spv return(pc) } # partial variances pvar.shrink = function(x, lambda, lambda.var, w, verbose=TRUE) { prec = invcov.shrink(x, lambda, lambda.var, w, verbose=verbose) pvar = 1/diag(prec) attr(pvar, "lambda") = attr(prec, "lambda") attr(pvar, "lambda.estimated") = attr(prec, "lambda.estimated") attr(pvar, "lambda.var") = attr(prec, "lambda.var") attr(pvar, "lambda.var.estimated") = attr(prec, "lambda.var.estimated") return( pvar ) } corpcor/R/fast.svd.R0000644000175100001440000000566512371445250014032 0ustar hornikusers### fast.svd.R (2006-04-24) ### ### Efficient Computation of the Singular Value Decomposition ### ### Copyright 2003-06 Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # private functions # svd that retains only positive singular values positive.svd = function(m, tol) { s = svd(m) if( missing(tol) ) tol = max(dim(m))*max(s$d)*.Machine$double.eps Positive = s$d > tol return(list( d=s$d[Positive], u=s$u[, Positive, drop=FALSE], v=s$v[, Positive, drop=FALSE] )) } # fast computation of svd(m) if n << p # (n are the rows, p are columns) nsmall.svd = function(m, tol) { B = m %*% t(m) # nxn matrix s = svd(B,nv=0) # of which svd is easy.. # determine rank of B (= rank of m) if( missing(tol) ) tol = dim(B)[1]*max(s$d)*.Machine$double.eps Positive = s$d > tol # positive singular values of m d = sqrt(s$d[Positive]) # corresponding orthogonal basis vectors u = s$u[, Positive, drop=FALSE] v = crossprod(m, u) %*% diag(1/d, nrow=length(d)) return(list(d=d,u=u,v=v)) } # fast computation of svd(m) if n >> p # (n are the rows, p are columns) psmall.svd = function(m, tol) { B = crossprod(m) # pxp matrix s = svd(B,nu=0) # of which svd is easy.. # determine rank of B (= rank of m) if( missing(tol) ) tol = dim(B)[1]*max(s$d)*.Machine$double.eps Positive = s$d > tol # positive singular values of m d = sqrt(s$d[Positive]) # corresponding orthogonal basis vectors v = s$v[, Positive, drop=FALSE] u = m %*% v %*% diag(1/d, nrow=length(d)) return(list(d=d,u=u,v=v)) } # public functions # fast computation of svd(m) # note that the signs of the columns vectors in u and v # may be different from that given by svd() # note that also only positive singular values are returned fast.svd = function(m, tol) { n = dim(m)[1] p = dim(m)[2] EDGE.RATIO = 2 # use standard SVD if matrix almost square if (n > EDGE.RATIO*p) { return(psmall.svd(m,tol)) } else if (EDGE.RATIO*n < p) { return(nsmall.svd(m,tol)) } else # if p and n are approximately the same { return(positive.svd(m, tol)) } } corpcor/R/shrink.intensity.R0000644000175100001440000000747013067467250015630 0ustar hornikusers### shrink.intensity.R (2017-03-31) ### ### Functions for computing the shrinkage intensity ### ### ### Copyright 2005-2017 Juliane Sch\"afer, Rainer Opgen-Rhein, ### Miika Ahdesm\"aki and Korbinian Strimmer ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # estimate shrinkage intensity lambda.var (variance vector) # # input: data matrix # weights of each data point # estimate.lambda.var = function(x, w, verbose=TRUE) { n = nrow(x) if (n < 3) stop("Sample size too small!") w = pvt.check.w(w, n) # bias correction factors w2 = sum(w*w) # for w=1/n this equals 1/n where n=dim(xc)[1] h1 = 1/(1-w2) # for w=1/n this equals the usual h1=n/(n-1) h1w2 = w2/(1-w2) # for w=1/n this equals 1/(n-1) # center input matrix xc = wt.scale(x, w, center=TRUE, scale=FALSE) # compute empirical variances #v = wt.moments(x, w)$var v = h1*(colSums(w*xc^2)) # compute shrinkage target target = median(v) if (verbose) cat("Estimating optimal shrinkage intensity lambda.var (variance vector): ") zz = xc^2 q1 = colSums( sweep(zz, MARGIN=1, STATS=w, FUN="*") ) q2 = colSums( sweep(zz^2, MARGIN=1, STATS=w, FUN="*") ) - q1^2 numerator = sum( q2 ) denominator = sum( (q1 - target/h1)^2 ) if(denominator == 0) lambda.var = 1 else lambda.var = max(0, min(1, numerator/denominator * h1w2)) if (verbose) cat(paste(round(lambda.var, 4), "\n")) return (lambda.var) } # estimate shrinkage intensity lambda (correlation matrix) # # input: data matrix # weights of each data point # # # note: the fast algorithm in this function is due to Miika Ahdesm\"aki # estimate.lambda = function(x, w, verbose=TRUE) { n = nrow(x) p = ncol(x) if (p == 1) return (1) if (n < 3) stop("Sample size too small!") w = pvt.check.w(w, n) xs = wt.scale(x, w, center=TRUE, scale=TRUE) # standardize data matrix if (verbose) cat("Estimating optimal shrinkage intensity lambda (correlation matrix): ") # bias correction factors w2 = sum(w*w) # for w=1/n this equals 1/n where n=dim(xs)[1] h1w2 = w2/(1-w2) # for w=1/n this equals 1/(n-1) sw = sqrt(w) # direct slow algorithm # E2R = (crossprod(sweep(xs, MARGIN=1, STATS=sw, FUN="*")))^2 # ER2 = crossprod(sweep(xs^2, MARGIN=1, STATS=sw, FUN="*")) # ## offdiagonal sums # sE2R = sum(E2R)-sum(diag(E2R)) # sER2 = sum(ER2)-sum(diag(ER2)) # Here's how to compute off-diagonal sums much more efficiently for n << p # this algorithm is due to Miika Ahdesm\"aki xsw = sweep(xs, MARGIN=1, STATS=sw, FUN="*") xswsvd = fast.svd(xsw) sE2R = sum(xsw*(sweep(xswsvd$u,2,xswsvd$d^3,'*')%*%t(xswsvd$v))) - sum(colSums(xsw^2)^2) remove(xsw,xswsvd) # free memory xs2w = sweep(xs^2, MARGIN=1, STATS=sw, FUN="*") sER2 = 2*sum(xs2w[,(p-1):1] * t(apply(xs2w[,p:2, drop=FALSE],1,cumsum))) remove(xs2w) # free memory ####### denominator = sE2R numerator = sER2 - sE2R if(denominator == 0) lambda = 1 else lambda = max(0, min(1, numerator/denominator * h1w2)) if (verbose) cat(paste(round(lambda, 4), "\n")) return (lambda) } corpcor/R/pseudoinverse.R0000644000175100001440000000217212371445250015163 0ustar hornikusers### pseudoinverse.R (2004-09-25) ### ### Computation of the Pseudoinverse of a Matrix ### ### Copyright 2003-04 Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA pseudoinverse = function (m, tol) { msvd = fast.svd(m, tol) if (length(msvd$d) == 0) { return( array(0, dim(m)[2:1]) ) } else { return( msvd$v %*% (1/msvd$d * t(msvd$u)) ) } } corpcor/R/shrink.misc.R0000644000175100001440000000454112371445250014522 0ustar hornikusers### shrink.internal.R (2008-12-01) ### ### Non-public functions used in the covariance shrinkage estimator ### ### ### Copyright 2005-08 Korbinian Strimmer ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # make sure we have weights that sum up to one pvt.check.w = function(w, n) { if (missing(w)) { w = rep(1/n, n) # equal weights } else { if (length(w) != n) { stop("Weight vector has incompatible length", call. = FALSE) } sw = sum(w) if (sw != 1) w = w/sw # make weights sum up to 1 } return(w) } # print function print.shrinkage = function(x, ...) { attr(x, "class") = NULL lambda = attr(x, "lambda") lambda.estimated = attr(x, "lambda.estimated") attr(x, "lambda") = NULL attr(x, "lambda.estimated") = NULL lambda.var = attr(x, "lambda.var") lambda.var.estimated = attr(x, "lambda.var.estimated") attr(x, "lambda.var") = NULL attr(x, "lambda.var.estimated") = NULL spv = attr(x, "spv") attr(x, "spv") = NULL NextMethod("print", x, quote = FALSE, right = TRUE) cat("\n") if (!is.null(lambda.estimated)) { if (lambda.estimated) le = "(estimated)" else le = "(specified)" cat(paste("Shrinkage intensity lambda (correlation matrix):", round(lambda,4), le, "\n")) } if (!is.null(lambda.var.estimated)) { if (lambda.var.estimated) lve = "(estimated)" else lve = "(specified)" cat(paste("Shrinkage intensity lambda.var (variance vector):", round(lambda.var, 4), lve, "\n")) } if (!is.null(spv)) { cat("Standardized partial variances (i.e. PVAR/VAR) are attached (attribute \"spv\").\n") } } corpcor/R/pvt.powscor.R0000644000175100001440000000740412371445250014577 0ustar hornikusers### pvt.powscor (2012-01-21) ### ### Non-public function for computing R_shrink^alpha ### ### Copyright 2008-2012 Verena Zuber and Korbinian Strimmer ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA ##### internal functions ###### # this procedure exploits a special identity to efficiently # compute the matrix power of the correlation shrinkage estimator # (see Zuber and Strimmer 2009) pvt.powscor = function(x, alpha, lambda, w, verbose) { #### determine correlation shrinkage intensity if (missing(lambda)) { lambda = estimate.lambda(x, w, verbose) lambda.estimated=TRUE } else { if (lambda < 0) lambda = 0 if (lambda > 1) lambda = 1 if (verbose) { cat(paste("Specified shrinkage intensity lambda (correlation matrix):", round(lambda, 4), "\n")) } lambda.estimated=FALSE } ##### n = nrow(x) w = pvt.check.w(w, n) xs = wt.scale(x, w, center=TRUE, scale=TRUE) # standardize data matrix # bias correction factor h1 = 1/(1-sum(w*w)) # for w=1/n this equals the usual h1=n/(n-1) p = ncol(xs) if (lambda == 1 | alpha == 0) # result in both cases is the identity matrix { powr = diag(p) # return identity matrix rownames(powr) = colnames(xs) colnames(powr) = colnames(xs) } else if (alpha == 1) # don't do SVD in this simple case { # unbiased empirical estimator # for w=1/n the following would simplify to: r = 1/(n-1)*crossprod(xs) #r0 = h1 * t(xs) %*% diag(w) %*% xs #r0 = h1 * t(xs) %*% sweep(xs, 1, w, "*") # sweep requires less memory r0 = h1 * crossprod( sweep(xs, 1, sqrt(w), "*") ) # even faster # shrink off-diagonal elements powr = (1-lambda)*r0 diag(powr) = 1 } else { # number of zero-variance variables zeros = (attr(xs, "scaled:scale")==0.0) svdxs = fast.svd(xs) m = length(svdxs$d) # rank of xs UTWU = t(svdxs$u) %*% sweep(svdxs$u, 1, w, "*") # t(U) %*% diag(w) %*% U C = sweep(sweep(UTWU, 1, svdxs$d, "*"), 2, svdxs$d, "*") # D %*% UTWU %*% D C = (1-lambda) * h1 * C C = (C + t(C))/2 # symmetrize for numerical reasons (mpower() checks symmetry) # note: C is of size m x m, and diagonal if w=1/n if (lambda==0.0) # use eigenvalue decomposition computing the matrix power { if (m < p-sum(zeros)) warning(paste("Estimated correlation matrix doesn't have full rank", "- pseudoinverse used for inversion."), call. = FALSE) powr = svdxs$v %*% tcrossprod( mpower(C, alpha), svdxs$v) } else # use a special identity for computing the matrix power { F = diag(m) - mpower(C/lambda + diag(m), alpha) powr = (diag(p) - svdxs$v %*% tcrossprod(F, svdxs$v))*(lambda)^alpha } # set all diagonal entries corresponding to zero-variance variables to 1 diag(powr)[zeros] = 1 rownames(powr) = colnames(xs) colnames(powr) = colnames(xs) } rm(xs) attr(powr, "lambda") = lambda attr(powr, "lambda.estimated") = lambda.estimated attr(powr, "class") = "shrinkage" if (verbose) cat("\n") return( powr ) } corpcor/R/shrink.estimates.R0000644000175100001440000000700712371445250015565 0ustar hornikusers### shrink.estimates.R (2012-01-21) ### ### Shrinkage Estimation of Variance Vector, Correlation Matrix, ### and Covariance Matrix ### ### Copyright 2005-12 Juliane Schaefer, Rainer Opgen-Rhein, ### Verena Zuber, A. Pedro Duarte Silva, and Korbinian Strimmer ### ### ### ### This file is part of the `corpcor' library for R and related languages. ### It is made available under the terms of the GNU General Public ### License, version 3, or at your option, any later version, ### incorporated herein by reference. ### ### This program is distributed in the hope that it will be ### useful, but WITHOUT ANY WARRANTY; without even the implied ### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ### PURPOSE. See the GNU General Public License for more ### details. ### ### You should have received a copy of the GNU General Public ### License along with this program; if not, write to the Free ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA # power of the shrinkage correlation matrix powcor.shrink = function(x, alpha, lambda, w, verbose=TRUE) { if (missing(alpha)) stop("Please specify the exponent alpha!") x = as.matrix(x) # matrix power of shrinkage correlation powr = pvt.powscor(x=x, alpha=alpha, lambda=lambda, w=w, verbose=verbose) return(powr) } # correlation cor.shrink = function(x, lambda, w, verbose=TRUE) { return ( powcor.shrink(x=x, alpha=1, lambda=lambda, w=w, verbose=verbose) ) } # inverse correlation invcor.shrink = function(x, lambda, w, verbose=TRUE) { return ( powcor.shrink(x=x, alpha=-1, lambda=lambda, w=w, verbose=verbose) ) } # variances var.shrink = function(x, lambda.var, w, verbose=TRUE) { x = as.matrix(x) # shrinkage variance sv = pvt.svar(x=x, lambda.var=lambda.var, w=w, verbose=verbose) return(sv) } # covariance cov.shrink = function(x, lambda, lambda.var, w, verbose=TRUE) { x = as.matrix(x) # shrinkage scale factors sc = sqrt( pvt.svar(x=x, lambda.var=lambda.var, w=w, verbose=verbose) ) # shrinkage correlation c = pvt.powscor(x=x, alpha=1, lambda=lambda, w=w, verbose=verbose) # shrinkage covariance if (is.null(dim(c))) c = c*sc*sc else c = sweep(sweep(c, 1, sc, "*"), 2, sc, "*") attr(c, "lambda.var") = attr(sc, "lambda.var") attr(c, "lambda.var.estimated") = attr(sc, "lambda.var.estimated") return(c) } # precision matrix (inverse covariance) invcov.shrink = function(x, lambda, lambda.var, w, verbose=TRUE) { x = as.matrix(x) # shrinkage scale factors sc = sqrt( pvt.svar(x=x, lambda.var=lambda.var, w=w, verbose=verbose) ) # inverse shrinkage correlation invc = pvt.powscor(x=x, alpha=-1, lambda=lambda, w=w, verbose=verbose) # inverse shrinkage covariance if (is.null(dim(invc))) invc = invc/sc/sc else invc = sweep(sweep(invc, 1, 1/sc, "*"), 2, 1/sc, "*") attr(invc, "lambda.var") = attr(sc, "lambda.var") attr(invc, "lambda.var.estimated") = attr(sc, "lambda.var.estimated") return(invc) } # computes R_shrink^alpha %*% y crossprod.powcor.shrink = function(x, y, alpha, lambda, w, verbose=TRUE) { if (missing(alpha)) stop("Please specify the exponent alpha!") x = as.matrix(x) y = as.matrix(y) p = ncol(x) if (nrow(y) != p) stop("Matrix y must have ", p, " rows!") # crossprod of matrix power of shrinkage correlation with y cp.powr = pvt.cppowscor(x=x, y=y, alpha=alpha, lambda=lambda, w=w, verbose=verbose) return(cp.powr) } corpcor/MD50000644000175100001440000000312713067644415012264 0ustar hornikusers0bed4c0923864db691678eb658a778b3 *DESCRIPTION 04dd551526f3048fd88714d7ce26b4a1 *NAMESPACE 259eae746dbb1e99cda9570b6a2ac9cb *NEWS 3fc9e2b797b62e30b44014a7ff6487cd *R/fast.svd.R c8c311c28ac6c6e53355ace75dcdcac5 *R/mpower.R 98829ad88c78430dd2a3341b9e6e3e40 *R/partial.R 88289059a0b5072134d2217f02ed4191 *R/pseudoinverse.R 952cee49546da217dd2b8afe73500e8d *R/pvt.cppowscor.R cff6f28e2621468bd35ffeaa8ef56cfa *R/pvt.powscor.R e956b4f371c7a719091a86d1790f7459 *R/pvt.svar.R 1a6da2dc4bf7029430395b83a310e894 *R/rank.condition.R b9b70de6713d3173fe7e2777a6350384 *R/rebuild.cov.R 9f4f6ab81e92a8899104a8c85e72ae0d *R/shrink.estimates.R bdd47085b64c2f4740a2c4b3ef69ca17 *R/shrink.intensity.R a23c8b8efee3ad7e11e513d3061ee9c9 *R/shrink.misc.R b8c3e4d9eb9a3e2539ccdf29a2e02043 *R/smtools.R c526455bc26476e592d14da8ef1a9c40 *R/wt.scale.R 7f7e9c145101d3e3e3eeb1239bb2f443 *man/cor2pcor.Rd 37c000d49e6344d93fafcdb2d1907932 *man/corpcor-internal.Rd 86b28a90f39d9303caa6278fbe0d2516 *man/corpcor.package.Rd 4129347d02aeec6b877f0b2070d31601 *man/cov.shrink.Rd 936856f0c09ae9e2072c9e4d15c4bc24 *man/fast.svd.Rd e77bc5c0963ccad298db3b96ce5d796e *man/invcov.shrink.Rd 0962aefde12b52c0f5ad5efb3807e868 *man/mpower.Rd 5c52560f22fd2e00c0ae19746bc65a8f *man/pcor.shrink.Rd 2330234367b41ec7b05c56c494be07e8 *man/powcor.shrink.Rd 33df16d0c6829daa7a9843c78565931e *man/pseudoinverse.Rd 77c7ddc3e0d2e09136f3fbf8b93c997c *man/rank.condition.Rd a631bbf2ae745bfb86db3ac8465dff65 *man/rebuild.cov.Rd cbc4b9869e826fd732c5432cbcf4a85b *man/shrink.intensity.Rd 3fbb74750841dac14d1a36bfe701fce9 *man/smtools.Rd ed33fcd7a72794c51ccec9b9135d94ab *man/wt.scale.Rd corpcor/DESCRIPTION0000644000175100001440000000302513067644415013457 0ustar hornikusersPackage: corpcor Version: 1.6.9 Date: 2017-03-31 Title: Efficient Estimation of Covariance and (Partial) Correlation Author: Juliane Schafer, Rainer Opgen-Rhein, Verena Zuber, Miika Ahdesmaki, A. Pedro Duarte Silva, and Korbinian Strimmer. Maintainer: Korbinian Strimmer Depends: R (>= 3.0.2) Imports: stats Suggests: Description: Implements a James-Stein-type shrinkage estimator for the covariance matrix, with separate shrinkage for variances and correlations. The details of the method are explained in Schafer and Strimmer (2005) and Opgen-Rhein and Strimmer (2007) . The approach is both computationally as well as statistically very efficient, it is applicable to "small n, large p" data, and always returns a positive definite and well-conditioned covariance matrix. In addition to inferring the covariance matrix the package also provides shrinkage estimators for partial correlations and partial variances. The inverse of the covariance and correlation matrix can be efficiently computed, as well as any arbitrary power of the shrinkage correlation matrix. Furthermore, functions are available for fast singular value decomposition, for computing the pseudoinverse, and for checking the rank and positive definiteness of a matrix. License: GPL (>= 3) URL: http://strimmerlab.org/software/corpcor/ Packaged: 2017-03-31 17:06:45 UTC; strimmer NeedsCompilation: no Repository: CRAN Date/Publication: 2017-04-01 06:30:37 UTC corpcor/man/0000755000175100001440000000000013067473576012534 5ustar hornikuserscorpcor/man/shrink.intensity.Rd0000644000175100001440000000573713067473576016362 0ustar hornikusers\name{shrink.intensity} \alias{estimate.lambda} \alias{estimate.lambda.var} \title{Estimation of Shrinkage Intensities} \description{ The functions \code{estimate.lambda} and \code{estimate.lambda.var} shrinkage intensities used for correlations and variances used in \code{\link{cor.shrink}} and \code{\link{var.shrink}}, respectively. } \usage{ estimate.lambda(x, w, verbose=TRUE) estimate.lambda.var(x, w, verbose=TRUE) } \arguments{ \item{x}{a data matrix} \item{w}{optional: weights for each data point - if not specified uniform weights are assumed (\code{w = rep(1/n, n)} with \code{n = nrow(x)}).} \item{verbose}{report shrinkage intensities (default: TRUE)} } \details{ \code{var.shrink} computes the empirical variance of each considered random variable, and shrinks them towards their median. The corresponding shrinkage intensity \code{lambda.var} is estimated using \deqn{\lambda_{var}^{*} = ( \sum_{k=1}^p Var(s_{kk}) )/ \sum_{k=1}^p (s_{kk} - median(s))^2 } where \eqn{median(s)} denotes the median of the empirical variances (see Opgen-Rhein and Strimmer 2007). Similarly, \code{cor.shrink} computes a shrinkage estimate of the correlation matrix by shrinking the empirical correlations towards the identity matrix. In this case the shrinkage intensity \code{lambda} equals \deqn{\lambda^{*} = \sum_{k \neq l} Var(r_{kl}) / \sum_{k \neq l} r_{kl}^2 } (Sch\"afer and Strimmer 2005). Ahdesm\"aki suggested (2012) a computationally highly efficient algorithm to compute the shrinkage intensity estimate for the correlation matrix (see the R code for the implementation). } \value{ \code{estimate.lambda} and \code{estimate.lambda.var} returns a number between 0 and 1. } \author{ Juliane Sch\"afer, Rainer Opgen-Rhein, Miika Ahdesm\"aki and Korbinian Strimmer (\url{http://strimmerlab.org}). } \references{ Opgen-Rhein, R., and K. Strimmer. 2007. Accurate ranking of differentially expressed genes by a distribution-free shrinkage approach. Statist. Appl. Genet. Mol. Biol. \bold{6}:9. Sch\"afer, J., and K. Strimmer. 2005. A shrinkage approach to large-scale covariance estimation and implications for functional genomics. Statist. Appl. Genet. Mol. Biol. \bold{4}:32. } \seealso{\code{\link{cor.shrink}}, \code{\link{var.shrink}}.} \examples{ # load corpcor library library("corpcor") # small n, large p p = 100 n = 20 # generate random pxp covariance matrix sigma = matrix(rnorm(p*p),ncol=p) sigma = crossprod(sigma)+ diag(rep(0.1, p)) # simulate multinormal data of sample size n sigsvd = svd(sigma) Y = t(sigsvd$v \%*\% (t(sigsvd$u) * sqrt(sigsvd$d))) X = matrix(rnorm(n * ncol(sigma)), nrow = n) \%*\% Y # correlation shrinkage intensity estimate.lambda(X) c = cor.shrink(X) attr(c, "lambda") # variance shrinkage intensity estimate.lambda.var(X) v = var.shrink(X) attr(v, "lambda.var") } \keyword{multivariate} corpcor/man/cor2pcor.Rd0000644000175100001440000000523012371445250014535 0ustar hornikusers\name{cor2pcor} \alias{cor2pcor} \alias{pcor2cor} \title{Compute Partial Correlation from Correlation Matrix -- and Vice Versa} \usage{ cor2pcor(m, tol) pcor2cor(m, tol) } \arguments{ \item{m}{covariance matrix or (partial) correlation matrix} \item{tol}{tolerance - singular values larger than tol are considered non-zero (default value: \code{tol = max(dim(m))*max(D)*.Machine$double.eps}). This parameter is needed for the singular value decomposition on which \code{\link{pseudoinverse}} is based. } } \description{ \code{cor2pcor} computes the pairwise \emph{partial} correlation coefficients from either a correlation or a covariance matrix. \code{pcor2cor} takes either a partial correlation matrix or a partial covariance matrix as input, and computes from it the corresponding correlation matrix. } \details{ The partial correlations are the negative standardized concentrations (which in turn are the off-diagonal elements of the inverse correlation or covariance matrix). In graphical Gaussian models the partial correlations represent the direct interactions between two variables, conditioned on all remaining variables. In the above functions the \code{\link{pseudoinverse}} is employed for inversion - hence even singular covariances (with some zero eigenvalues) may be used. However, a better option may be to estimate a positive definite covariance matrix using \code{\link{cov.shrink}}. Note that for efficient computation of partial correlation coefficients from data \code{x} it is advised to use \code{pcor.shrink(x)} and \emph{not} \code{cor2pcor(cor.shrink(x))}. } \value{ A matrix with the pairwise partial correlation coefficients (\code{cor2pcor}) or with pairwise correlations (\code{pcor2cor}). } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \references{ Whittaker J. 1990. Graphical Models in Applied Multivariate Statistics. John Wiley, Chichester. } \seealso{\code{\link{decompose.invcov}}, \code{\link{pcor.shrink}}, \code{\link{pseudoinverse}}.} \examples{ # load corpcor library library("corpcor") # covariance matrix m.cov = rbind( c(3,1,1,0), c(1,3,0,1), c(1,0,2,0), c(0,1,0,2) ) m.cov # corresponding correlation matrix m.cor.1 = cov2cor(m.cov) m.cor.1 # compute partial correlations (from covariance matrix) m.pcor.1 = cor2pcor(m.cov) m.pcor.1 # compute partial correlations (from correlation matrix) m.pcor.2 = cor2pcor(m.cor.1) m.pcor.2 zapsmall( m.pcor.1 ) == zapsmall( m.pcor.2 ) # backtransformation m.cor.2 = pcor2cor(m.pcor.1) m.cor.2 zapsmall( m.cor.1 ) == zapsmall( m.cor.2 ) } \keyword{multivariate} corpcor/man/cov.shrink.Rd0000644000175100001440000001221713067472276015106 0ustar hornikusers\name{cov.shrink} \alias{cov.shrink} \alias{cor.shrink} \alias{var.shrink} \title{Shrinkage Estimates of Covariance and Correlation} \description{ The functions \code{var.shrink}, \code{cor.shrink}, and \code{cov.shrink} compute shrinkage estimates of variance, correlation, and covariance, respectively. } \usage{ var.shrink(x, lambda.var, w, verbose=TRUE) cor.shrink(x, lambda, w, verbose=TRUE) cov.shrink(x, lambda, lambda.var, w, verbose=TRUE) } \arguments{ \item{x}{a data matrix} \item{lambda}{the correlation shrinkage intensity (range 0-1). If \code{lambda} is not specified (the default) it is estimated using an analytic formula from Sch\"afer and Strimmer (2005) - see details below. For \code{lambda=0} the empirical correlations are recovered.} \item{lambda.var}{the variance shrinkage intensity (range 0-1). If \code{lambda.var} is not specified (the default) it is estimated using an analytic formula from Opgen-Rhein and Strimmer (2007) - see details below. For \code{lambda.var=0} the empirical variances are recovered.} \item{w}{optional: weights for each data point - if not specified uniform weights are assumed (\code{w = rep(1/n, n)} with \code{n = nrow(x)}).} \item{verbose}{output some status messages while computing (default: TRUE)} } \details{ \code{var.shrink} computes the empirical variance of each considered random variable, and shrinks them towards their median. The shrinkage intensity is estimated using \code{\link{estimate.lambda.var}} (Opgen-Rhein and Strimmer 2007). Similarly \code{cor.shrink} computes a shrinkage estimate of the correlation matrix by shrinking the empirical correlations towards the identity matrix. In this case the shrinkage intensity is computed using \code{\link{estimate.lambda}} (Sch\"afer and Strimmer 2005). In comparison with the standard empirical estimates (\code{\link{var}}, \code{\link{cov}}, and \code{\link{cor}}) the shrinkage estimates exhibit a number of favorable properties. For instance, \enumerate{ \item they are typically much more efficient, i.e. they show (sometimes dramatically) better mean squared error, \item the estimated covariance and correlation matrices are always positive definite and well conditioned (so that there are no numerical problems when computing their inverse), \item they are inexpensive to compute, and \item they are fully automatic and do not require any tuning parameters (as the shrinkage intensity is analytically estimated from the data), and \item they assume nothing about the underlying distributions, except for the existence of the first two moments.} These properties also carry over to derived quantities, such as partial variances and partial correlations (\code{\link{pvar.shrink}} and \code{\link{pcor.shrink}}). As an extra benefit, the shrinkage estimators have a form that can be \emph{very} efficiently inverted, especially if the number of variables is large and the sample size is small. Thus, instead of inverting the matrix output by \code{cov.shrink} and \code{cor.shrink} please use the functions \code{\link{invcov.shrink}} and \code{\link{invcor.shrink}}, respectively. } \value{ \code{var.shrink} returns a vector with estimated variances. \code{cov.shrink} returns a covariance matrix. \code{cor.shrink} returns the corresponding correlation matrix. } \author{ Juliane Sch\"afer, Rainer Opgen-Rhein, and Korbinian Strimmer (\url{http://strimmerlab.org}). } \references{ Opgen-Rhein, R., and K. Strimmer. 2007. Accurate ranking of differentially expressed genes by a distribution-free shrinkage approach. Statist. Appl. Genet. Mol. Biol. \bold{6}:9. Sch\"afer, J., and K. Strimmer. 2005. A shrinkage approach to large-scale covariance estimation and implications for functional genomics. Statist. Appl. Genet. Mol. Biol. \bold{4}:32. } \seealso{\code{\link{invcov.shrink}}, \code{\link{pcor.shrink}}, \code{\link{cor2pcor}}} \examples{ # load corpcor library library("corpcor") # small n, large p p = 100 n = 20 # generate random pxp covariance matrix sigma = matrix(rnorm(p*p),ncol=p) sigma = crossprod(sigma)+ diag(rep(0.1, p)) # simulate multinormal data of sample size n sigsvd = svd(sigma) Y = t(sigsvd$v \%*\% (t(sigsvd$u) * sqrt(sigsvd$d))) X = matrix(rnorm(n * ncol(sigma)), nrow = n) \%*\% Y # estimate covariance matrix s1 = cov(X) s2 = cov.shrink(X) # squared error sum((s1-sigma)^2) sum((s2-sigma)^2) # compare positive definiteness is.positive.definite(sigma) is.positive.definite(s1) is.positive.definite(s2) # compare ranks and condition rank.condition(sigma) rank.condition(s1) rank.condition(s2) # compare eigenvalues e0 = eigen(sigma, symmetric=TRUE)$values e1 = eigen(s1, symmetric=TRUE)$values e2 = eigen(s2, symmetric=TRUE)$values m = max(e0, e1, e2) yl = c(0, m) par(mfrow=c(1,3)) plot(e1, main="empirical") plot(e2, ylim=yl, main="full shrinkage") plot(e0, ylim=yl, main="true") par(mfrow=c(1,1)) } \keyword{multivariate} corpcor/man/wt.scale.Rd0000644000175100001440000000226312371445250014527 0ustar hornikusers\name{wt.scale} \alias{wt.scale} \alias{wt.var} \alias{wt.moments} \title{Weighted Expectations and Variances} \description{ \code{wt.var} estimate the unbiased variance taking into account data weights. \code{wt.moments} produces the weighted mean and weighted variance for each column of a matrix. \code{wt.scale} centers and standardized a matrix using the weighted means and variances. } \usage{ wt.var(xvec, w) wt.moments(x, w) wt.scale(x, w, center=TRUE, scale=TRUE) } \arguments{ \item{xvec}{a vector} \item{x}{a matrix} \item{w}{data weights} \item{center}{logical value} \item{scale}{logical value} } \value{ A rescaled matrix (\code{wt.scale}), a list containing the column means and variances (\code{wt.moments}), or single number (\code{wt.var}) } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \seealso{\code{\link{weighted.mean}}, \code{\link{cov.wt}}.} \examples{ # load corpcor library library("corpcor") # generate some data p = 5 n = 5 X = matrix(rnorm(n*p), nrow = n, ncol = p) w = c(1,1,1,3,3)/9 # standardize matrix scale(X) wt.scale(X) wt.scale(X, w) # take into account data weights } \keyword{multivariate} corpcor/man/rank.condition.Rd0000644000175100001440000000470613067473446015746 0ustar hornikusers\name{rank.condition} \alias{is.positive.definite} \alias{make.positive.definite} \alias{rank.condition} \title{Positive Definiteness of a Matrix, Rank and Condition Number} \usage{ is.positive.definite(m, tol, method=c("eigen", "chol")) make.positive.definite(m, tol) rank.condition(m, tol) } \arguments{ \item{m}{a matrix (assumed to be real and symmetric)} \item{tol}{tolerance for singular values and for absolute eigenvalues - only those with values larger than tol are considered non-zero (default: \code{tol = max(dim(m))*max(D)*.Machine$double.eps}) } \item{method}{Determines the method to check for positive definiteness: eigenvalue computation (\code{eigen}, default) or Cholesky decomposition (\code{chol}).} } \description{ \code{is.positive.definite} tests whether all eigenvalues of a symmetric matrix are positive. \code{make.positive.definite} computes the nearest positive definite of a real symmetric matrix, using the algorithm of NJ Higham (1988) . \code{rank.condition} estimates the rank and the condition of a matrix by computing its singular values D[i] (using \code{\link{svd}}). The rank of the matrix is the number of singular values \code{D[i] > tol}) and the condition is the ratio of the largest and the smallest singular value. The definition \code{tol= max(dim(m))*max(D)*.Machine$double.eps} is exactly compatible with the conventions used in "Octave" or "Matlab". Also note that it is not checked whether the input matrix m is real and symmetric. } \value{ \code{is.positive.definite} returns a logical value (\code{TRUE} or \code{FALSE}). \code{rank.condition} returns a list object with the following components: \item{rank}{Rank of the matrix.} \item{condition}{Condition number.} \item{tol}{Tolerance.} \code{make.positive.definite} returns a symmetric positive definite matrix. } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \seealso{\code{\link{svd}}, \code{\link{pseudoinverse}}.} \examples{ # load corpcor library library("corpcor") # Hilbert matrix hilbert = function(n) { i = 1:n; 1 / outer(i - 1, i, "+") } # positive definite ? m = hilbert(8) is.positive.definite(m) # numerically ill-conditioned m = hilbert(15) rank.condition(m) # make positive definite m2 = make.positive.definite(m) is.positive.definite(m2) rank.condition(m2) m2 - m } \keyword{algebra} corpcor/man/corpcor.package.Rd0000644000175100001440000000320313067472161016047 0ustar hornikusers\encoding{latin1} \name{corpcor-package} \alias{corpcor-package} \docType{package} \title{The corpcor Package} \description{ This package implements a James-Stein-type shrinkage estimator for the covariance matrix, with separate shrinkage for variances and correlations. The details of the method are explained in Sch\"afer and Strimmer (2005) and Opgen-Rhein and Strimmer (2007) . The approach is both computationally as well as statistically very efficient, it is applicable to ``small n, large p'' data, and always returns a positive definite and well-conditioned covariance matrix. In addition to inferring the covariance matrix the package also provides shrinkage estimators for partial correlations, partial variances, and regression coefficients. The inverse of the covariance and correlation matrix can be efficiently computed, and as well as any arbitrary power of the shrinkage correlation matrix. Furthermore, functions are available for fast singular value decomposition, for computing the pseudoinverse, and for checking the rank and positive definiteness of a matrix. The name of the package refers to \bold{cor}relations and \bold{p}artial \bold{cor}relations. } \author{Juliane Sch\"afer, Rainer Opgen-Rhein, Verena Zuber, Miika Ahdesm\"aki, A. Pedro Duarte Silva, and Korbinian Strimmer (\url{http://strimmerlab.org/})} \references{ See website: \url{http://strimmerlab.org/software/corpcor/} } \keyword{multivariate} \seealso{ \code{\link{cov.shrink}, \link{invcov.shrink}, \link{powcor.shrink}, \link{pcor.shrink}, \link{fast.svd}.} } corpcor/man/pseudoinverse.Rd0000644000175100001440000000373212371445250015704 0ustar hornikusers\name{pseudoinverse} \alias{pseudoinverse} \title{Pseudoinverse of a Matrix} \usage{ pseudoinverse(m, tol) } \arguments{ \item{m}{matrix} \item{tol}{tolerance - singular values larger than tol are considered non-zero (default value: \code{tol = max(dim(m))*max(D)*.Machine$double.eps}) } } \description{ The standard definition for the inverse of a matrix fails if the matrix is not square or singular. However, one can generalize the inverse using singular value decomposition. Any rectangular real matrix M can be decomposed as \deqn{M = U D V^{'},}{M = U D V',} where U and V are orthogonal, V' means V transposed, and D is a diagonal matrix containing only the positive singular values (as determined by \code{tol}, see also \code{\link{fast.svd}}). The pseudoinverse, also known as Moore-Penrose or generalized inverse is then obtained as \deqn{iM = V D^{-1} U^{'}}{iM = V D^(-1) U' .} } \details{ The pseudoinverse has the property that the sum of the squares of all the entries in \code{iM \%*\% M - I}, where I is an appropriate identity matrix, is minimized. For non-singular matrices the pseudoinverse is equivalent to the standard inverse. } \value{ A matrix (the pseudoinverse of m). } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \seealso{\code{\link{solve}}, \code{\link{fast.svd}}} \examples{ # load corpcor library library("corpcor") # a singular matrix m = rbind( c(1,2), c(1,2) ) # not possible to invert exactly try(solve(m)) # pseudoinverse p = pseudoinverse(m) p # characteristics of the pseudoinverse zapsmall( m \%*\% p \%*\% m ) == zapsmall( m ) zapsmall( p \%*\% m \%*\% p ) == zapsmall( p ) zapsmall( p \%*\% m ) == zapsmall( t(p \%*\% m ) ) zapsmall( m \%*\% p ) == zapsmall( t(m \%*\% p ) ) # example with an invertable matrix m2 = rbind( c(1,1), c(1,0) ) zapsmall( solve(m2) ) == zapsmall( pseudoinverse(m2) ) } \keyword{algebra} corpcor/man/powcor.shrink.Rd0000644000175100001440000001125613067473206015624 0ustar hornikusers\name{powcor.shrink} \alias{powcor.shrink} \alias{crossprod.powcor.shrink} \title{Fast Computation of the Power of the Shrinkage Correlation Matrix} \description{ The function \code{powcor.shrink} efficiently computes the \code{alpha}-th power of the shrinkage correlation matrix produced by \code{\link{cor.shrink}}. For instance, this function may be used for fast computation of the (inverse) square root of the shrinkage correlation matrix (needed, e.g., for decorrelation). \code{crossprod.powcor.shrink} efficiently computes \eqn{R^{\alpha} y} without actually computing the full matrix \eqn{R^{\alpha}}. } \usage{ powcor.shrink(x, alpha, lambda, w, verbose=TRUE) crossprod.powcor.shrink(x, y, alpha, lambda, w, verbose=TRUE) } \arguments{ \item{x}{a data matrix} \item{y}{a matrix, the number of rows of y must be the same as the number of columns of x} \item{alpha}{exponent} \item{lambda}{the correlation shrinkage intensity (range 0-1). If \code{lambda} is not specified (the default) it is estimated using an analytic formula from Sch\"afer and Strimmer (2005) - see \code{\link{cor.shrink}}. For \code{lambda=0} the empirical correlations are recovered.} \item{w}{optional: weights for each data point - if not specified uniform weights are assumed (\code{w = rep(1/n, n)} with \code{n = nrow(x)}).} \item{verbose}{output status while computing (default: TRUE)} } \details{ This function employs a special matrix identity to speed up the computation of the matrix power of the shrinkage correlation matrix (see Zuber and Strimmer 2009 for details). Apart from a scaling factor the shrinkage correlation matrix computed by \code{\link{cor.shrink}} takes on the form \deqn{Z = I_p + V M V^T ,} where \code{V M V^T} is a multiple of the empirical correlation matrix. Crucially, \code{Z} is a matrix of size \code{p} times \code{p} whereas \code{M} is a potentially much smaller matrix of size \code{m} times \code{m}, where \code{m} is the rank of the empirical correlation matrix. In order to calculate the \code{alpha}-th power of \code{Z} the function uses the identity \deqn{Z^\alpha = I_p - V (I_m -(I_m + M)^\alpha) V^T} requiring only the computation of the \code{alpha}-th power of the \code{m} by \code{m} matrix \eqn{I_m + M}. This trick enables substantial computational savings especially when the number of observations is much smaller than the number of variables. Note that the above identity is related but not identical to the Woodbury matrix identity for inversion of a matrix. For \eqn{\alpha=-1} the above identity reduces to \deqn{Z^{-1} = I_p - V (I_m -(I_m + M)^{-1}) V^T ,} whereas the Woodbury matrix identity equals \deqn{Z^{-1} = I_p - V (I_m + M^{-1})^{-1} V^T .} } \value{ \code{powcor.shrink} returns a matrix of the same size as the correlation matrix \code{R} \code{crossprod.powcor.shrink} returns a matrix of the same size as \code{R} \code{y}. } \author{ Verena Zuber, A. Pedro Duarte Silva, and Korbinian Strimmer (\url{http://strimmerlab.org}). } \references{ Zuber, V., and K. Strimmer. 2009. Gene ranking and biomarker discovery under correlation. Bioinformatics \bold{25}:2700-2707. Zuber, V., A. P. Duarte Silva, and K. Strimmer. 2012. A novel algorithm for simultaneous SNP selection in high-dimensional genome-wide association studies. BMC Bioinformatics 13: 284 } \seealso{\code{\link{invcor.shrink}}, \code{\link{cor.shrink}}, \code{\link{mpower}}.} \examples{ # load corpcor library library("corpcor") # generate data matrix p = 500 n = 10 X = matrix(rnorm(n*p), nrow = n, ncol = p) lambda = 0.23 # some arbitrary lambda ### computing the inverse ### # slow system.time( (W1 = solve(cor.shrink(X, lambda=lambda))) ) # very fast system.time( (W2 = powcor.shrink(X, alpha=-1, lambda=lambda)) ) # no difference sum((W1-W2)^2) ### computing the square root ### system.time( (W1 = mpower(cor.shrink(X, lambda=lambda), alpha=0.5)) ) # very fast system.time( (W2 = powcor.shrink(X, alpha=0.5, lambda=lambda)) ) # no difference sum((W1-W2)^2) ### computing an arbitrary power (alpha=1.23) ### system.time( (W1 = mpower(cor.shrink(X, lambda=lambda), alpha=1.23)) ) # very fast system.time( (W2 = powcor.shrink(X, alpha=1.23, lambda=lambda)) ) # no difference sum((W1-W2)^2) ### fast computation of cross product y = rnorm(p) system.time( (CP1 = crossprod(powcor.shrink(X, alpha=1.23, lambda=lambda), y)) ) system.time( (CP2 = crossprod.powcor.shrink(X, y, alpha=1.23, lambda=lambda)) ) # no difference sum((CP1-CP2)^2) } \keyword{multivariate} corpcor/man/fast.svd.Rd0000644000175100001440000000536412463374264014554 0ustar hornikusers\name{fast.svd} \alias{fast.svd} \title{Fast Singular Value Decomposition} \description{ \code{fast.svd} returns the singular value decomposition of a rectangular real matrix \deqn{M = U D V^{'},}{M = U D V',} where \eqn{U} and \eqn{V} are orthogonal matrices with \eqn{U' U = I} and \eqn{V' V = I}, and \eqn{D} is a diagonal matrix containing the singular values (see \code{\link{svd}}). The main difference to the native version \code{\link{svd}} is that \code{fast.svd} is substantially faster for "fat" (small n, large p) and "thin" (large n, small p) matrices. In this case the decomposition of \eqn{M} can be greatly sped up by first computing the SVD of either \eqn{M M'} (fat matrices) or \eqn{M' M} (thin matrices), rather than that of \eqn{M}. A second difference to \code{\link{svd}} is that \code{fast.svd} only returns the \emph{positive} singular values (thus the dimension of \eqn{D} always equals the rank of \eqn{M}). Note that the singular vectors computed by \code{fast.svd} may differ in sign from those computed by \code{\link{svd}}. } \usage{ fast.svd(m, tol) } \arguments{ \item{m}{matrix} \item{tol}{tolerance - singular values larger than tol are considered non-zero (default value: \code{tol = max(dim(m))*max(D)*.Machine$double.eps}) } } \details{ For "fat" \eqn{M} (small n, large p) the SVD decomposition of \eqn{M M'} yields \deqn{M M^{'} = U D^2 U}{M M' = U D^2 U'} As the matrix \eqn{M M'} has dimension n x n only, this is faster to compute than SVD of \eqn{M}. The \eqn{V} matrix is subsequently obtained by \deqn{V = M^{'} U D^{-1}}{V = M' U D^(-1)} Similarly, for "thin" \eqn{M} (large n, small p), the decomposition of \eqn{M' M} yields \deqn{M^{'} M = V D^2 V^{'}}{M' M = V D^2 V'} which is also quick to compute as \eqn{M' M} has only dimension p x p. The \eqn{U} matrix is then computed via \deqn{U = M V D^{-1}}{U = M V D^(-1)} } \value{ A list with the following components: \item{d}{a vector containing the \emph{positive} singular values} \item{u}{a matrix with the corresponding left singular vectors} \item{v}{a matrix with the corresponding right singular vectors} } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \seealso{\code{\link{svd}}, \code{\link{solve}}.} \examples{ # load corpcor library library("corpcor") # generate a "fat" data matrix n = 50 p = 5000 X = matrix(rnorm(n*p), n, p) # compute SVD system.time( (s1 = svd(X)) ) system.time( (s2 = fast.svd(X)) ) eps = 1e-10 sum(abs(s1$d-s2$d) > eps) sum(abs(abs(s1$u)-abs(s2$u)) > eps) sum(abs(abs(s1$v)-abs(s2$v)) > eps) } \keyword{algebra} corpcor/man/invcov.shrink.Rd0000644000175100001440000000516213067472507015621 0ustar hornikusers\name{invcov.shrink} \alias{invcov.shrink} \alias{invcor.shrink} \title{Fast Computation of the Inverse of the Covariance and Correlation Matrix} \description{ The functions \code{invcov.shrink} and \code{invcor.shrink} implement an algorithm to \emph{efficiently} compute the inverses of shrinkage estimates of covariance (\code{\link{cov.shrink}}) and correlation (\code{\link{cor.shrink}}). } \usage{ invcov.shrink(x, lambda, lambda.var, w, verbose=TRUE) invcor.shrink(x, lambda, w, verbose=TRUE) } \arguments{ \item{x}{a data matrix} \item{lambda}{the correlation shrinkage intensity (range 0-1). If \code{lambda} is not specified (the default) it is estimated using an analytic formula from Sch\"afer and Strimmer (2005) - see \code{\link{cor.shrink}}. For \code{lambda=0} the empirical correlations are recovered.} \item{lambda.var}{the variance shrinkage intensity (range 0-1). If \code{lambda.var} is not specified (the default) it is estimated using an analytic formula from Sch\"afer and Strimmer (2005) - see \code{\link{var.shrink}}. For \code{lambda.var=0} the empirical variances are recovered.} \item{w}{optional: weights for each data point - if not specified uniform weights are assumed (\code{w = rep(1/n, n)} with \code{n = nrow(x)}).} \item{verbose}{output status while computing (default: TRUE)} } \details{ Both \code{invcov.shrink} and \code{invcor.shrink} rely on \code{\link{powcor.shrink}}. This allows to compute the inverses in a very efficient fashion (much more efficient than directly inverting the matrices - see the example). } \value{ \code{invcov.shrink} returns the inverse of the output from \code{\link{cov.shrink}}. \code{invcor.shrink} returns the inverse of the output from \code{\link{cor.shrink}}. } \author{ Juliane Sch\"afer and Korbinian Strimmer (\url{http://strimmerlab.org}). } \references{ Sch\"afer, J., and K. Strimmer. 2005. A shrinkage approach to large-scale covariance estimation and implications for functional genomics. Statist. Appl. Genet. Mol. Biol. \bold{4}:32. } \seealso{\code{\link{powcor.shrink}}, \code{\link{cov.shrink}}, \code{\link{pcor.shrink}}, \code{\link{cor2pcor}}} \examples{ # load corpcor library library("corpcor") # generate data matrix p = 500 n = 10 X = matrix(rnorm(n*p), nrow = n, ncol = p) lambda = 0.23 # some arbitrary lambda # slow system.time( (W1 = solve(cov.shrink(X, lambda))) ) # very fast system.time( (W2 = invcov.shrink(X, lambda)) ) # no difference sum((W1-W2)^2) } \keyword{multivariate} corpcor/man/smtools.Rd0000644000175100001440000000326012371445250014505 0ustar hornikusers\name{smtools} \alias{sm2vec} \alias{sm.index} \alias{vec2sm} \title{Some Tools for Handling Symmetric Matrices} \usage{ sm2vec(m, diag = FALSE) sm.index(m, diag = FALSE) vec2sm(vec, diag = FALSE, order = NULL) } \arguments{ \item{m}{symmetric matrix} \item{diag}{logical. Should the diagonal be included in the conversion to and from a vector?} \item{vec}{vector of unique elements from a symmetric matrix} \item{order}{order of the entries in \code{vec}} } \description{ \code{sm2vec} takes a symmetric matrix and puts the lower triagonal entries into a vector (cf. \code{\link{lower.tri}}). \code{sm.index} lists the corresponding x-y-indices for each entry in the vector produced by \code{sm2vec}. \code{vec2sm} reverses the operation by \code{sm2vec} and converts the vector back to a symmetric matrix. If \code{diag=FALSE} the diagonal of the resulting matrix will consist of NAs. If \code{order} is supplied then the input vector \code{vec} will first be rearranged accordingly. } \value{ A vector (\code{sm2vec}), a two-column matrix with indices (\code{sm.index}), or a symmetric matrix (\code{vec2sm}). } \author{ Korbinian Strimmer (\url{http://strimmerlab.org/}). } \seealso{\code{\link{lower.tri}}.} \examples{ # load corpcor library library("corpcor") # a symmetric matrix m = rbind( c(3,1,1,0), c(1,3,0,1), c(1,0,2,0), c(0,1,0,2) ) m # convert into vector (including the diagonals) v = sm2vec(m, diag=TRUE) v.idx = sm.index(m, diag=TRUE) v v.idx # put back to symmetric matrix vec2sm(v, diag=TRUE) # convert from vector with specified order of the elements sv = sort(v) sv ov = order(v) ov vec2sm(sv, diag=TRUE, order=ov) } \keyword{utilities} corpcor/man/corpcor-internal.Rd0000644000175100001440000000067212371445250016272 0ustar hornikusers\name{corpcor-internal} \alias{positive.svd} \alias{nsmall.svd} \alias{psmall.svd} \alias{pvt.powscor} \alias{pvt.cppowscor} \alias{pvt.svar} \alias{pvt.check.w} \alias{print.shrinkage} \title{Internal corpcor Functions} \description{ Internal corpcor functions. } \note{ These are not to be called by the user (or in some cases are just waiting for proper documentation to be written). } \keyword{internal} corpcor/man/pcor.shrink.Rd0000644000175100001440000000702413067472573015262 0ustar hornikusers\name{pcor.shrink} \alias{pcor.shrink} \alias{pvar.shrink} \title{Shrinkage Estimates of Partial Correlation and Partial Variance} \description{ The functions \code{pcor.shrink} and \code{pvar.shrink} compute shrinkage estimates of partial correlation and partial variance, respectively. } \usage{ pcor.shrink(x, lambda, w, verbose=TRUE) pvar.shrink(x, lambda, lambda.var, w, verbose=TRUE) } \arguments{ \item{x}{a data matrix} \item{lambda}{the correlation shrinkage intensity (range 0-1). If \code{lambda} is not specified (the default) it is estimated using an analytic formula from Sch\"afer and Strimmer (2005) - see \code{\link{cor.shrink}}. For \code{lambda=0} the empirical correlations are recovered.} \item{lambda.var}{the variance shrinkage intensity (range 0-1). If \code{lambda.var} is not specified (the default) it is estimated using an analytic formula from Opgen-Rhein and Strimmer (2007) - see details below. For \code{lambda.var=0} the empirical variances are recovered.} \item{w}{optional: weights for each data point - if not specified uniform weights are assumed (\code{w = rep(1/n, n)} with \code{n = nrow(x)}).} \item{verbose}{report progress while computing (default: TRUE)} } \details{ The partial variance \eqn{var(X_k | rest)} is the variance of \eqn{X_k} conditioned on the remaining variables. It equals the inverse of the corresponding diagonal entry of the precision matrix (see Whittaker 1990). The partial correlations \eqn{corr(X_k, X_l | rest)} is the correlation between \eqn{X_k} and \eqn{X_l} conditioned on the remaining variables. It equals the sign-reversed entries of the off-diagonal entries of the precision matrix, standardized by the the squared root of the associated inverse partial variances. Note that using \code{pcor.shrink(x)} \emph{much} faster than \code{cor2pcor(cor.shrink(x))}. For details about the shrinkage procedure consult Sch\"afer and Strimmer (2005), Opgen-Rhein and Strimmer (2007), and the help page of \code{\link{cov.shrink}}. } \value{ \code{pcor.shrink} returns the partial correlation matrix. Attached to this matrix are the standardized partial variances (i.e. PVAR/VAR) that can be retrieved using \code{\link{attr}} under the attribute "spv". \code{pvar.shrink} returns the partial variances. } \author{ Juliane Sch\"afer and Korbinian Strimmer (\url{http://strimmerlab.org}). } \references{ Opgen-Rhein, R., and K. Strimmer. 2007. Accurate ranking of differentially expressed genes by a distribution-free shrinkage approach. Statist. Appl. Genet. Mol. Biol. \bold{6}:9. Sch\"afer, J., and K. Strimmer. 2005. A shrinkage approach to large-scale covariance estimation and implications for functional genomics. Statist. Appl. Genet. Mol. Biol. \bold{4}:32. Whittaker J. 1990. Graphical Models in Applied Multivariate Statistics. John Wiley, Chichester. } \seealso{\code{\link{invcov.shrink}}, \code{\link{cov.shrink}}, \code{\link{cor2pcor}}} \examples{ # load corpcor library library("corpcor") # generate data matrix p = 50 n = 10 X = matrix(rnorm(n*p), nrow = n, ncol = p) # partial variance pv = pvar.shrink(X) pv # partial correlations (fast and recommend way) pcr1 = pcor.shrink(X) # other possibilities to estimate partial correlations pcr2 = cor2pcor( cor.shrink(X) ) # all the same sum((pcr1 - pcr2)^2) } \keyword{multivariate} corpcor/man/mpower.Rd0000644000175100001440000000322212371445250014314 0ustar hornikusers\name{mpower} \alias{mpower} \title{Compute the Power of a Real Symmetric Matrix} \usage{ mpower(m, alpha, pseudo=FALSE, tol) } \arguments{ \item{m}{a real-valued symmetric matrix.} \item{alpha}{exponent.} \item{pseudo}{if \code{pseudo=TRUE} then all zero eigenvalues are dropped (e.g. for computing the pseudoinverse). The default is to use all eigenvalues.} \item{tol}{tolerance - eigenvalues with absolute value smaller or equal to \code{tol} are considered identically zero (default: \code{tol = max(dim(m))*max(abs(eval))*.Machine$double.eps}). } } \description{ \code{mpower} computes \eqn{m^alpha}, i.e. the \code{alpha}-th power of the real symmetric matrix \code{m}. } \value{ \code{mpower} returns a matrix of the same dimensions as \code{m}. } \details{ The matrix power of \code{m} is obtained by first computing the spectral decomposition of \code{m}, and subsequent modification of the resulting eigenvalues. Note that \code{m} is assumed to by symmetric, and only its lower triangle (diagonal included) is used in \code{\link{eigen}}. For computing the matrix power of \code{\link{cor.shrink}} use the vastly more efficient function \code{\link{powcor.shrink}}. } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \seealso{\code{\link{powcor.shrink}}, \code{\link{eigen}}.} \examples{ # load corpcor library library("corpcor") # generate symmetric matrix p = 10 n = 20 X = matrix(rnorm(n*p), nrow = n, ncol = p) m = cor(X) m \%*\% m mpower(m, 2) solve(m) mpower(m, -1) msq = mpower(m, 0.5) msq \%*\% msq m mpower(m, 1.234) } \keyword{algebra} corpcor/man/rebuild.cov.Rd0000644000175100001440000000452412371445250015225 0ustar hornikusers\name{rebuild.cov} \alias{rebuild.cov} \alias{rebuild.invcov} \alias{decompose.cov} \alias{decompose.invcov} \title{Rebuild and Decompose the (Inverse) Covariance Matrix} \usage{ rebuild.cov(r, v) rebuild.invcov(pr, pv) decompose.cov(m) decompose.invcov(m) } \arguments{ \item{r}{correlation matrix} \item{v}{variance vector} \item{pr}{partial correlation matrix} \item{pv}{partial variance vector} \item{m}{a covariance or a concentration matrix} } \description{ \code{rebuild.cov} takes a correlation matrix and a vector with variances and reconstructs the corresponding covariance matrix. Conversely, \code{decompose.cov} decomposes a covariance matrix into correlations and variances. \code{decompose.invcov} decomposes a concentration matrix (=inverse covariance matrix) into partial correlations and partial variances. \code{rebuild.invcov} takes a partial correlation matrix and a vector with partial variances and reconstructs the corresponding concentration matrix. } \details{ The diagonal elements of the concentration matrix (=inverse covariance matrix) are the precisions, and the off-diagonal elements are the concentrations. Thus, the partial variances correspond to the inverse precisions, and the partial correlations to the negative standardized concentrations. } \value{ \code{rebuild.cov} and \code{rebuild.invcov} return a matrix. \code{decompose.cov} and \code{decompose.invcov} return a list containing a matrix and a vector. } \author{ Korbinian Strimmer (\url{http://strimmerlab.org}). } \seealso{\code{\link{cor}}, \code{\link{cov}}, \code{\link{pcor.shrink}}} \examples{ # load corpcor library library("corpcor") # a correlation matrix and some variances r = matrix(c(1, 1/2, 1/2, 1), nrow = 2, ncol=2) r v = c(2, 3) # construct the associated covariance matrix c = rebuild.cov(r, v) c # decompose into correlations and variances decompose.cov(c) # the corresponding concentration matrix conc = pseudoinverse(c) conc # decompose into partial correlation matrix and partial variances tmp = decompose.invcov(conc) tmp # note: because this is an example with two variables, # the partial and standard correlations are identical! # reconstruct the concentration matrix from partial correlations and # partial variances rebuild.invcov(tmp$pr, tmp$pv) } \keyword{multivariate}