miscTools/0000755000176200001440000000000013573136753012243 5ustar liggesusersmiscTools/NAMESPACE0000644000176200001440000000226713547627536013476 0ustar liggesusersexport( "checkNames" ) export( "coefTable" ) export( "colMedians" ) export( "rowMedians" ) export( "compPlot" ) export( "ddnorm" ) export( "insertCol" ) export( "insertRow" ) export( "isSemidefinite" ) export( "margEff" ) export( "nObs" ) export( "nParam" ) export( "quasiconcavity" ) export( "quasiconvexity" ) export( "rSquared" ) export( "semidefiniteness" ) export( "stdEr" ) export( "sumKeepAttr" ) export( "summarizeDF" ) export( "symMatrix" ) export( "triang" ) export( "vecli" ) export( "vecli2m" ) export( "veclipos" ) S3method( "isSemidefinite", "default" ) S3method( "isSemidefinite", "list" ) S3method( "isSemidefinite", "matrix" ) S3method( "margEff", "default" ) S3method( "nObs", "default" ) S3method( "nObs", "lm" ) S3method( "nParam", "default" ) S3method( "nParam", "lm" ) S3method( "stdEr", "default" ) S3method( "stdEr", "lm" ) importFrom( "digest", "digest" ) importFrom( "graphics", "abline" ) importFrom( "graphics", "plot.default" ) importFrom( "stats", "coef" ) importFrom( "stats", "coefficients" ) importFrom( "stats", "dnorm" ) importFrom( "stats", "median" ) importFrom( "stats", "pt" ) importFrom( "stats", "vcov" ) importFrom( "stats", "sd" ) importFrom( "utils", "combn" ) miscTools/man/0000755000176200001440000000000013573133131013001 5ustar liggesusersmiscTools/man/triang.Rd0000755000176200001440000000100411315172501014546 0ustar liggesusers\name{triang} \alias{triang} \title{Upper triangular matrix from a vector} \description{ Creates an upper triangular square matrix from a vector. } \usage{triang( v, n )} \arguments{ \item{v}{vector} \item{n}{desired dimension of the returned square matrix} } \note{ If the vector has less elements than the upper triangular matrix, the last elements are set to zero. } \seealso{\code{\link{veclipos}}.} \author{Arne Henningsen} \examples{ v <- c( 1:5 ) triang( v, 3 ) } \keyword{array} miscTools/man/miscTools-internal.Rd0000644000176200001440000000046213062274311017057 0ustar liggesusers\name{miscTools-internal} \alias{checkNames} % Document the following: %%%% \title{ Undocumented miscTools Functions } \description{ Undocumented miscTools Functions } \details{ These are various methods or functions waiting for proper documentation to be written :). } \keyword{ internal } miscTools/man/colMedians.Rd0000644000176200001440000000170711344461541015356 0ustar liggesusers\name{colMedians} \alias{colMedians} \title{Medians of Columns} \description{ Compute the sample medians of the columns (non-rows) of a data.frame or array. } \usage{ colMedians( x, na.rm = FALSE ) } \arguments{ \item{x}{a data.frame or array.} \item{na.rm}{a logical value indicating whether \code{NA} values should be stripped before the computation proceeds.} } \value{ A vector or array of the medians of each column (non-row) of \code{x} with dimension \code{dim( x )[-1]}. } \seealso{\code{\link{rowMedians}},\code{\link{median}},\code{\link{colMeans}}.} \author{Arne Henningsen} \examples{ data( "Electricity", package = "Ecdat" ) colMedians( Electricity ) a4 <- array( 1:120, dim = c(5,4,3,2), dimnames = list( c("a","b","c","d","e"), c("A","B","C","D"), c("x","y","z"), c("Y","Z") ) ) colMedians( a4 ) median( a4[ , "B", "x", "Z" ] ) # equal to colMedians( a4 )[ "B", "x", "Z" ] } \keyword{array} miscTools/man/veclipos.Rd0000755000176200001440000000146211315172501015116 0ustar liggesusers\name{veclipos} \alias{veclipos} \title{Position in a vector of linear independent values} \description{ Returns the position of the [\code{i},\code{j}]th element of a symmetric \code{n} \eqn{\times}{x} \code{n} matrix that this element has in a vector of the linear independent values of the matrix. } \usage{veclipos( i, j, n )} \arguments{ \item{i}{row of the element in the matrix.} \item{j}{column of the element in the matrix.} \item{n}{dimension of the matrix.} } \note{ A symmetric \code{n} \eqn{\times}{x} \code{n} matrix has n*(n+1)/2 independent values.\cr The function is: n*(n-1)/2-((n-min(i,j))*(n-min(i,j)+1)/2)+max(i,j) } \seealso{\code{\link{vecli}}, \code{\link{vecli2m}}.} \author{Arne Henningsen} \examples{ veclipos( 1, 2, 3 ) # returns: 2 } \keyword{array} miscTools/man/semidefiniteness.Rd0000644000176200001440000001311513034451366016634 0ustar liggesusers\name{isSemidefinite} \alias{isSemidefinite} \alias{isSemidefinite.default} \alias{isSemidefinite.list} \alias{isSemidefinite.matrix} \alias{semidefiniteness} \title{Positive or Negative Semidefiniteness} \description{ Check whether a symmetric matrix is positive or negative semidefinite. } \usage{ isSemidefinite( m, \dots ) \method{isSemidefinite}{default}( m, \dots ) \method{isSemidefinite}{matrix}( m, positive = TRUE, tol = 100 * .Machine$double.eps, method = ifelse( nrow( m ) < 13, "det", "eigen" ), \dots ) \method{isSemidefinite}{list}( m, \dots ) semidefiniteness( m, \dots ) } \arguments{ \item{m}{a symmetric quadratic matrix or a list containing symmetric quadratic matrices.} \item{positive}{logical. Check for positive semidefiniteness (if \code{TRUE}, default) or for negative semidefiniteness (if \code{FALSE}).} \item{tol}{tolerance level (values between \code{-tol} and \code{tol} are considered to be zero).} \item{method}{method to test for semidefiniteness, either checking the signs of the principal minors (if \code{"det"}, default for matrices with up to 12 rows/columns) or checking the signs of the eigenvalues (if \code{"eigen"}, default for matrices with 13 or more rows/columns).} \item{\dots}{further arguments of \code{isSemidefinite.list} are passed to \code{isSemidefinite.matrix};. further arguments of \code{semidefiniteness} are passed to \code{isSemidefinite}; further arguments of other functions are currently ignored.} } \details{ Function \code{semidefiniteness()} passes all its arguments to \code{isSemidefinite()}. It is only kept for backward-compatibility and may be removed in the future. If argument \code{positive} is set to \code{FALSE}, \code{isSemidefinite()} checks for negative semidefiniteness by checking for positive semidefiniteness of the negative of argument \code{m}, i.e. \code{-m}. If method \code{"det"} is used (default for matrices with up to 12 rows/columns), \code{isSemidefinite()} checks whether all principal minors (not only the leading principal minors) of the matrix \code{m} (or of the matrix \code{-m} if argument \code{positive} is \code{FALSE}) are larger than \code{-tol}. Due to rounding errors, which are unavoidable on digital computers, the calculated determinants of singular (sub-)matrices (which should theoretically be zero) can considerably deviate from zero. In order to reduce the probability of incorrect results due to rounding errors, \code{isSemidefinite()} does not calculate the determinants of (sub-)matrices with reciprocal condition numbers smaller than argument \code{tol} but sets the corresponding principal minors to (exactly) zero. The number of principal minors of an \eqn{N \times N}{N x N} matrix is \eqn{\sum_{k=1}^N ( N} choose \eqn{ k )}, which gets very large for large matrices. Therefore, it is not recommended to use method \code{"det"} for matrices with, say, more than 12 rows/columns. If method \code{"eigen"} (default for matrices with 13 or more rows/columns) is used, \code{isSemidefinite()} checks whether all eigenvalues of the matrix \code{m} (or of the matrix \code{-m} if argument \code{positive} is \code{FALSE}) are larger than \code{-tol}. In case of a singular or nearly singular matrix, some eigenvalues that theoretically should be zero can considerably deviate from zero due to rounding errors, which are unavoidable on digital computers. \code{isSemidefinite()} uses the following procedure to reduce the probability of incorrectly returning \code{FALSE} due to rounding errors in the calculation of eigenvalues of singular or nearly singular matrices: if the reciprocal condition number of an \eqn{N \times N}{NxN} matrix is smaller than argument \code{tol} and not all of the eigenvalues of this matrix are larger than \code{-tol}, \code{isSemidefinite()} checks whether all \eqn{( N} choose \eqn{ (N-k) )} \eqn{(N-k) \times (N-k)}{(N-k) x (N-k)} submatrices are positive semidefinite, where \eqn{k} with \eqn{0 < k < N} is the number of eigenvalues in the interval \code{-tol} and \code{tol}. If necessary, this procedure is done recursively. Please note that a matrix can be neither positive semidefinite nor negative semidefinite. } \value{ \code{isSemidefinite()} and \code{semidefiniteness()} return a locigal value (if argument \code{m} is a matrix) or a logical vector (if argument \code{m} is a list) indicating whether the matrix (or each of the matrices) is positive/negative (depending on argument \code{positive}) semidefinite. } \references{ Chiang, A.C. (1984): \emph{Fundamental Methods of Mathematical Economics}, 3rd ed., McGraw-Hill. Gantmacher, F.R. (1959): \emph{The Theory of Matrices}, Chelsea Publishing. } \author{Arne Henningsen} \examples{ # a positive semidefinite matrix isSemidefinite( matrix( 1, 3, 3 )) # a negative semidefinite matrix isSemidefinite( matrix(-1, 3, 3 ), positive = FALSE ) # a matrix that is positive and negative semidefinite isSemidefinite( matrix( 0, 3, 3 )) isSemidefinite( matrix( 0, 3, 3 ), positive = FALSE ) # a matrix that is neither positive nor negative semidefinite isSemidefinite( symMatrix( 1:6 ) ) isSemidefinite( symMatrix( 1:6 ), positive = FALSE ) # checking a list of matrices ml <- list( matrix( 1, 3, 3 ), matrix(-1, 3, 3 ), matrix( 0, 3, 3 ) ) isSemidefinite( ml ) isSemidefinite( ml, positive = FALSE ) } \keyword{array} miscTools/man/insertRow.Rd0000644000176200001440000000114011315172501015254 0ustar liggesusers\name{insertRow} \alias{insertRow} \title{Insert Row into a Matrix} \description{ Insert a new row into a matrix. } \usage{insertRow( m, r, v = NA, rName = "" )} \arguments{ \item{ m }{matrix.} \item{ r }{row number where the new row should be inserted.} \item{ v }{optional values for the new row.} \item{ rName }{optional character string: the name of the new row.} } \value{ a matrix with one more row than the provided matrix \code{m}. } \seealso{\code{\link{insertCol}}.} \author{Arne Henningsen} \examples{ m <- matrix( 1:4, 2 ) insertRow( m, 2, 5:6 ) } \keyword{array} miscTools/man/coefTable.Rd0000644000176200001440000000134411315172501015152 0ustar liggesusers\name{coefTable} \alias{coefTable} \title{Coefficient Table} \description{ Generate Table for Coefficients, Std. Errors, t-values and P-values. } \usage{ coefTable( coef, stdErr, df = NULL ) } \arguments{ \item{coef}{vector that contains the coefficients.} \item{stdErr}{vector that contains the standard errors of the coefficients.} \item{df}{degrees of freedom of the t-test used to calculate P-values.} } \value{ a matrix with 4 columns: coefficients, standard errors, t-values and P-values. If argument \code{df} is not provided, the last column (P-values) is filled with \code{NA}s. } \author{Arne Henningsen} \examples{ coefTable( rnorm( 10 ), 0.5 * abs( rnorm( 10 ) ), 20 ) } \keyword{models} miscTools/man/symMatrix.Rd0000644000176200001440000000177611315172501015274 0ustar liggesusers\name{symMatrix} \alias{symMatrix} \title{Symmetric Matrix} \description{ Create a Symmetric Matrix. } \usage{ symMatrix( data = NA, nrow = NULL, byrow = FALSE, upper = FALSE ) } \arguments{ \item{data}{an optional data vector.} \item{nrow}{the desired number of rows and columns.} \item{byrow}{logical. If 'FALSE' (the default) the matrix is filled by columns, otherwise the matrix is filled by rows.} \item{upper}{logical. If 'FALSE' (the default) the lower triangular part of the matrix (including the diagonal) is filled, otherwise the upper triangular part of the matrix is filled.} } \value{ a symmetric matrix. } \seealso{\code{\link{matrix}}, \code{\link{lower.tri}}.} \author{Arne Henningsen} \examples{ # fill the lower triangular part by columns symMatrix( 1:10, 4 ) # fill the upper triangular part by columns symMatrix( 1:10, 4, upper = TRUE ) # fill the lower triangular part by rows symMatrix( 1:10, 4, byrow = FALSE ) } \keyword{array} miscTools/man/insertCol.Rd0000644000176200001440000000116411315172501015230 0ustar liggesusers\name{insertCol} \alias{insertCol} \title{Insert Column into a Matrix} \description{ Insert a new column into a matrix. } \usage{insertCol( m, c, v = NA, cName = "" )} \arguments{ \item{ m }{matrix.} \item{ c }{column number where the new column should be inserted.} \item{ v }{optional values of the new column.} \item{ cName }{optional character string: the name of the new column.} } \value{ a matrix with one more column than the provided matrix \code{m}. } \seealso{\code{\link{insertRow}}.} \author{Arne Henningsen} \examples{ m <- matrix( 1:4, 2 ) insertCol( m, 2, 5:6 ) } \keyword{array} miscTools/man/compPlot.Rd0000644000176200001440000000156212066621770015100 0ustar liggesusers\name{compPlot} \alias{compPlot} \title{Scatterplot to Compare two Variables} \description{ Plot a scatterplot to compare two variables. } \usage{ compPlot( x, y, lim = NULL, ... ) } \arguments{ \item{x}{values of the first variable (on the X axis).} \item{y}{values of the second variable (on the Y axis).} \item{lim}{optional vector of two elements specifying the limits of both axes).} \item{\dots}{further arguments are passed to \code{\link[graphics]{plot}}.} } \author{Arne Henningsen} \examples{ set.seed( 123 ) x <- runif( 25 ) y <- 2 + 3 * x + rnorm( 25 ) ols <- lm( y ~ x ) compPlot( y, fitted( ols ) ) compPlot( y, fitted( ols ), lim = c( 0, 10 ) ) compPlot( y, fitted( ols ), pch = 20 ) compPlot( y, fitted( ols ), xlab = "observed", ylab = "fitted" ) compPlot( y, fitted( ols ), log = "xy" ) } \keyword{models} miscTools/man/rSquared.Rd0000644000176200001440000000103411315734373015063 0ustar liggesusers\name{rSquared} \alias{rSquared} \title{Calculate R squared value} \description{ Calculate R squared value. } \usage{rSquared( y, resid )} \arguments{ \item{ y }{vector of endogenous variables} \item{ resid }{vector of residuals} } \author{Arne Henningsen} \examples{ data( "Electricity", package = "Ecdat" ) reg <- lm( cost ~ q + pl + pk + pf, Electricity ) rSquared( Electricity$cost, reg$residuals ) summary( reg )$r.squared # returns the same value } \keyword{univar} \keyword{multivariate} \keyword{array} miscTools/man/nParam.Rd0000644000176200001440000000222511400733751014510 0ustar liggesusers\name{nParam} \alias{nParam} \alias{nParam.default} \alias{nParam.lm} \title{Number of model parameters} \description{ This function returns the number of model parameters. The default method returns the component \code{x$param$nParam}. } \usage{ nParam(x, free=FALSE, \dots) \method{nParam}{default}(x, \dots) \method{nParam}{lm}(x, \dots) } \arguments{ \item{x}{a statistical model} \item{free}{logical, whether to report only the free parameters or the total number of parameters (default)} \item{\dots}{other arguments for methods} } \details{ Free parameters are the parameters with no equality restrictions. Some parameters may be restricted (e.g. sum of two probabilities may be restricted to equal unity). In this case the total number of parameters may depend on the normalisation. } \value{ Number of parameters in the model } \author{Ott Toomet, \email{otoomet@econ.au.dk}} \seealso{\code{\link{nObs}} for number of observations} \examples{ # Construct a simple OLS regression: x1 <- runif(100) x2 <- runif(100) y <- 3 + 4*x1 + 5*x2 + rnorm(100) m <- lm(y~x1+x2) # estimate it summary(m) nParam(m) # you get 3 } \keyword{methods} miscTools/man/nObs.Rd0000644000176200001440000000177211642321257014203 0ustar liggesusers\name{nObs} \alias{nObs} \alias{nObs.default} \alias{nObs.lm} \title{Return number of observations for statistical models} \description{ Returns number of observations for statistical models. The default method assumes presence of a component \code{param$nObs} in \code{x}. } \usage{ nObs(x, \dots) \method{nObs}{default}(x, \dots) \method{nObs}{lm}(x, \dots) } \arguments{ \item{x}{a statistical model, such as created by \code{\link{lm}}} \item{\dots}{further arguments for methods} } \details{ This is a generic function. The default method returns the component \code{x$param$nObs}. The \code{lm}-method is based on qr-decomposition, in the same way as the does \code{\link{summary.lm}}. } \value{ numeric, number of observations } \author{Ott Toomet, \email{otoomet@econ.au.dk}} \seealso{\code{\link[maxLik]{nParam}}} \examples{ # Construct a simple OLS regression: x1 <- runif(100) x2 <- runif(100) y <- 3 + 4*x1 + 5*x2 + rnorm(100) m <- lm(y~x1+x2) # estimate it nObs(m) } \keyword{methods} miscTools/man/summarizeDF.Rd0000644000176200001440000000232513550017257015525 0ustar liggesusers\name{summarizeDF} \alias{summarizeDF} \title{Summarize a data.rrame} \description{ This function summarizes each variable that is in a data.frame. It can be used, e.g., in an R script to write summary information about a data.frame into a text file that is in a version control system so that one can see in the version control system whether one or more variables in the data frame have changed. } \usage{ summarizeDF( dat, printValues = TRUE, maxLevel = 20, file = NULL, ... ) } \arguments{ \item{dat}{a data.frame.} \item{printValues}{logical. If \code{FALSE} only MD5 checksums are returned, which could be desirable if the data frame contains confidential data that should not be included in the output.} \item{maxLevel}{integer. If the number of unique values in a variable is less than or equal to the number specified in this argument (and argument \code{printValues} is \code{TRUE}), a frequency table is included in the output.} \item{file}{a character string or a writable connection naming the file to write to.} \item{...}{further arguments forwarded to \code{sink()} if argument \code{file} is not \code{NULL}.} } \author{Arne Henningsen} \keyword{methods} miscTools/man/quasiconcavity.Rd0000644000176200001440000000214611315172501016331 0ustar liggesusers\name{quasiconcavity} \alias{quasiconcavity} \alias{quasiconvexity} \title{Test for quasiconcavity / quasiconvexity} \description{ Test wether a function is quasiconcave or quasiconvex. The bordered Hessian of this function is checked by \code{quasiconcavity}() or \code{quasiconvexity}(). } \usage{ quasiconcavity( m, tol = .Machine$double.eps ) quasiconvexity( m, tol = .Machine$double.eps ) } \arguments{ \item{m}{a bordered Hessian matrix or a list containing bordered Hessian matrices} \item{tol}{tolerance level (values between \code{-tol} and \code{tol} are considered to be zero).} } \value{ locigal or a logical vector (if \code{m} is a list). } \references{ Chiang, A.C. (1984) \emph{Fundamental Methods of Mathematical Economics}, 3rd ed., McGraw-Hill. } \author{Arne Henningsen} \examples{ quasiconcavity( matrix( 0, 3, 3 ) ) quasiconvexity( matrix( 0, 3, 3 ) ) m <- list() m[[1]] <- matrix( c( 0,-1,-1, -1,-2,3, -1,3,5 ), 3, 3 ) m[[2]] <- matrix( c( 0,1,-1, 1,-2,3, -1,3,5 ), 3, 3 ) quasiconcavity( m ) quasiconvexity( m ) } \keyword{array} miscTools/man/stdEr.Rd0000644000176200001440000000151211437676477014376 0ustar liggesusers\name{stdEr} \alias{stdEr} \alias{stdEr.default} \alias{stdEr.lm} \title{Standard deviations} \description{ Extract standard deviations from estimated models. } \usage{ stdEr(x, ...) \method{stdEr}{default}(x, \dots) \method{stdEr}{lm}(x, \dots) } \arguments{ \item{x}{a statistical model, such as created by \code{\link{lm}}} \item{\dots}{further arguments for methods} } \details{ \code{stdEr} is a generic function with methods for objects of "lm" class. The default method returns the square root of the diagonal of the variance-covariance matrix. } \value{ numeric, the estimated standard errors of the coefficients. } \author{ Ott Toomet \email{otoomet@ut.ee} } \seealso{\code{\link{vcov}}, \code{\link{summary}}.} \examples{ data(cars) lmRes <- lm(dist ~ speed, data=cars) stdEr( lmRes ) } \keyword{methods} miscTools/man/rowMedians.Rd0000644000176200001440000000115511344460104015377 0ustar liggesusers\name{rowMedians} \alias{rowMedians} \title{Medians of Rows} \description{ Compute the sample medians of the rows of a data.frame or matrix. } \usage{ rowMedians( x, na.rm = FALSE ) } \arguments{ \item{x}{a data.frame or matrix.} \item{na.rm}{a logical value indicating whether \code{NA} values should be stripped before the computation proceeds.} } \value{ A vector of the medians of each row of \code{x}. } \seealso{\code{\link{colMedians}},\code{\link{median}},\code{\link{colMeans}}.} \author{Arne Henningsen} \examples{ m <- matrix( 1:12, nrow = 4 ) rowMedians( m ) } \keyword{array} miscTools/man/ddnorm.Rd0000644000176200001440000000152411403434732014556 0ustar liggesusers\name{ddnorm} \alias{ddnorm} \title{Derivative of the Normal Distribution's Density Function} \description{ This function returns the derivative(s) of the density function of the normal (Gaussian) distribution with respect to the quantile, evaluated at the quantile(s), mean(s), and standard deviation(s) specified by arguments \code{x}, \code{mean}, and \code{sd}, respectively. } \usage{ ddnorm( x, mean = 0, sd = 1 ) } \arguments{ \item{x}{quantile or vector of quantiles.} \item{mean}{mean or vector of means.} \item{sd}{standard deviation or vector of standard deviations.} } \value{ numeric value(s): derivative(s) of the density function of the normal distribution with respect to the quantile } \author{Arne Henningsen} \seealso{\code{\link[stats]{dnorm}}} \examples{ ddnorm( c( -1, 0, 1 ) ) } \keyword{methods} miscTools/man/vecli.Rd0000755000176200001440000000073211315172501014373 0ustar liggesusers\name{vecli} \alias{vecli} \title{Vector of linear independent values} \description{ Returns a vector containing the linear independent elements of a symmetric matrix (of full rank). } \usage{vecli( m )} \arguments{ \item{ m }{symmetric matrix} } \seealso{\code{\link{veclipos}}.} \author{Arne Henningsen} \examples{ # a symmetric n x n matrix m <- cbind(c(11,12,13),c(12,22,23),c(13,23,33)) vecli(m) # returns: 11 12 13 22 23 33 } \keyword{array} miscTools/man/sumKeepAttr.Rd0000644000176200001440000000151511414403154015533 0ustar liggesusers\name{sumKeepAttr} \alias{sumKeepAttr} \title{Sum of an Array While Keeping its Attributes} \description{ This function returns the sum of an numeric array (e.g. vector or matrix) while keeping its attributes. } \usage{ sumKeepAttr( x, keepNames = FALSE, na.rm = FALSE ) } \arguments{ \item{x}{an numeric array (e.g. vector or matrix).} \item{keepNames}{logical. Should the name(s) of the element(s) of\code{x} be assigned to the returned sum? (only relevant if code{x} has only one element).} \item{na.rm}{logical. Passed to \code{\link[base]{sum}}. Should missing values be removed?} } \value{ the sum (see \code{\link[base]{sum}}). } \author{Arne Henningsen} \seealso{\code{\link[base]{sum}}} \examples{ a <- 1:10 attr( a, "min" ) <- 1 attr( a, "max" ) <- 10 sum(a) sumKeepAttr(a) } \keyword{methods} miscTools/man/vecli2m.Rd0000644000176200001440000000075211315172501014631 0ustar liggesusers\name{vecli2m} \alias{vecli2m} \title{Convert vector of linear independent values into a Matrix} \description{ Converts a vector into a symmetric matrix that the original vector contains the linear independent values of the returned symmetric matrix. } \usage{vecli2m( v )} \arguments{ \item{ v }{a vector.} } \seealso{\code{\link{vecli}}, \code{\link{veclipos}}.} \author{Arne Henningsen} \examples{ v <- c( 11, 12, 13, 22, 23, 33 ) vecli2m( v ) } \keyword{array} miscTools/man/margEff.Rd0000644000176200001440000000075511642321247014650 0ustar liggesusers\name{margEff} \alias{margEff} \title{Method for Returning Marginal Effects} \description{ Currently, this package just defines the generic function \code{margEff} so that it can be used to define \code{margEff} methods for objects of specific classes in other packages. } \usage{ margEff( object, \dots ) } \arguments{ \item{ object }{an object of which marginal effects should be calculated.} \item{\dots}{further arguments for methods} } \author{Arne Henningsen} \keyword{methods} miscTools/DESCRIPTION0000644000176200001440000000145513573136753013756 0ustar liggesusersPackage: miscTools Version: 0.6-26 Date: 2019-12-08 Title: Miscellaneous Tools and Utilities Author: Arne Henningsen, Ott Toomet Maintainer: Arne Henningsen Depends: R (>= 2.14.0) Imports: digest Suggests: Ecdat (>= 0.1-5) Description: Miscellaneous small tools and utilities. Many of them facilitate the work with matrices, e.g. inserting rows or columns, creating symmetric matrices, or checking for semidefiniteness. Other tools facilitate the work with regression models, e.g. extracting the standard errors, obtaining the number of (estimated) parameters, or calculating R-squared values. License: GPL (>= 2) URL: http://www.micEcon.org NeedsCompilation: no Packaged: 2019-12-08 08:37:45 UTC; gsl324 Repository: CRAN Date/Publication: 2019-12-08 09:10:03 UTC miscTools/tests/0000755000176200001440000000000013573133131013370 5ustar liggesusersmiscTools/tests/ddnormTest.R0000644000176200001440000000062311403434315015635 0ustar liggesuserslibrary( miscTools ) eps <- 1e-7 x <- (-40:40)/10 ## standard normal distribution ddnorm( x ) all.equal( ddnorm(x), ( dnorm( x + eps ) - dnorm( x - eps ) ) / ( 2 * eps ) ) ## normal distribution (non-standard) x <- (0:100)/10 ddnorm( x, mean = 5, sd = 2 ) all.equal( ddnorm( x, mean = 5, sd = 2), ( dnorm( x + eps, mean = 5, sd = 2 ) - dnorm( x - eps, mean = 5, sd = 2 ) ) / ( 2 * eps ) ) miscTools/tests/lmMethods.R0000644000176200001440000000030311400734530015440 0ustar liggesuserslibrary( "miscTools" ) # Construct a simple OLS regression: set.seed( 123 ) x1 <- runif(100) x2 <- runif(100) y <- 3 + 4*x1 + 5*x2 + rnorm(100) m <- lm(y~x1+x2) # estimate it nObs(m) nParam(m) miscTools/tests/summarizeDF_tests.Rout.save0000644000176200001440000003704713550017317020665 0ustar liggesusers R version 3.6.1 (2019-07-05) -- "Action of the Toes" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## testing summarizeDF() > library( "miscTools" ) > data( "cars" ) > > summarizeDF( cars ) Summary of data.frame number of observations: 50 number of variables: 2 MD5: f98a59010652c8e1ee062ed4c43f648e variable: speed MD5: 4eb3e01aee9abbc01e91d22b651be559 [,1] Min. 4.0 1st Qu. 12.0 Median 15.0 Mean 15.4 3rd Qu. 19.0 Max. 25.0 [,1] 4 2 7 2 8 1 9 1 10 3 11 2 12 4 13 4 14 4 15 3 16 2 17 3 18 4 19 3 20 5 22 1 23 1 24 4 25 1 variable: dist MD5: be6c7701fccdd59b5e47c48881a2acae [,1] Min. 2.00 1st Qu. 26.00 Median 36.00 Mean 42.98 3rd Qu. 56.00 Max. 120.00 > > summarizeDF( cars, maxLevel = 10 ) Summary of data.frame number of observations: 50 number of variables: 2 MD5: f98a59010652c8e1ee062ed4c43f648e variable: speed MD5: 4eb3e01aee9abbc01e91d22b651be559 [,1] Min. 4.0 1st Qu. 12.0 Median 15.0 Mean 15.4 3rd Qu. 19.0 Max. 25.0 variable: dist MD5: be6c7701fccdd59b5e47c48881a2acae [,1] Min. 2.00 1st Qu. 26.00 Median 36.00 Mean 42.98 3rd Qu. 56.00 Max. 120.00 > > summarizeDF( cars, printValues = FALSE ) Summary of data.frame number of observations: 50 number of variables: 2 MD5: f98a59010652c8e1ee062ed4c43f648e variable: speed MD5: 4eb3e01aee9abbc01e91d22b651be559 variable: dist MD5: be6c7701fccdd59b5e47c48881a2acae > > tmpFile <- file() > summarizeDF( cars, file = tmpFile ) > tmpLines <- readLines( tmpFile ) > close( tmpFile ) > print( matrix( tmpLines, ncol = 1 ) ) [,1] [1,] "Summary of data.frame" [2,] "number of observations: 50 " [3,] "number of variables: 2 " [4,] "MD5: f98a59010652c8e1ee062ed4c43f648e " [5,] "" [6,] "variable: speed " [7,] "MD5: 4eb3e01aee9abbc01e91d22b651be559 " [8,] " [,1]" [9,] "Min. 4.0" [10,] "1st Qu. 12.0" [11,] "Median 15.0" [12,] "Mean 15.4" [13,] "3rd Qu. 19.0" [14,] "Max. 25.0" [15,] " [,1]" [16,] "4 2" [17,] "7 2" [18,] "8 1" [19,] "9 1" [20,] "10 3" [21,] "11 2" [22,] "12 4" [23,] "13 4" [24,] "14 4" [25,] "15 3" [26,] "16 2" [27,] "17 3" [28,] "18 4" [29,] "19 3" [30,] "20 5" [31,] "22 1" [32,] "23 1" [33,] "24 4" [34,] "25 1" [35,] "" [36,] "variable: dist " [37,] "MD5: be6c7701fccdd59b5e47c48881a2acae " [38,] " [,1]" [39,] "Min. 2.00" [40,] "1st Qu. 26.00" [41,] "Median 36.00" [42,] "Mean 42.98" [43,] "3rd Qu. 56.00" [44,] "Max. 120.00" [45,] "" > > > data( "iris" ) > > summarizeDF( iris ) Summary of data.frame number of observations: 150 number of variables: 5 MD5: d3c5d071001b61a9f6131d3004fd0988 variable: Sepal.Length MD5: b2bce49565d07c62a84d53cee81d8569 [,1] Min. 4.300000 1st Qu. 5.100000 Median 5.800000 Mean 5.843333 3rd Qu. 6.400000 Max. 7.900000 variable: Sepal.Width MD5: 35bd921d86f4fe19d5cadc03c687f538 [,1] Min. 2.000000 1st Qu. 2.800000 Median 3.000000 Mean 3.057333 3rd Qu. 3.300000 Max. 4.400000 variable: Petal.Length MD5: e610b9d68cb18ce39b1c0ac098e38bea [,1] Min. 1.000 1st Qu. 1.600 Median 4.350 Mean 3.758 3rd Qu. 5.100 Max. 6.900 variable: Petal.Width MD5: 5f70e007e1a5054816b90e5846c14467 [,1] Min. 0.100000 1st Qu. 0.300000 Median 1.300000 Mean 1.199333 3rd Qu. 1.800000 Max. 2.500000 variable: Species MD5: f7e071c073ca18cd4d0d7cf86d961dd1 setosa versicolor virginica 50 50 50 > > summarizeDF( iris, printValues = FALSE ) Summary of data.frame number of observations: 150 number of variables: 5 MD5: d3c5d071001b61a9f6131d3004fd0988 variable: Sepal.Length MD5: b2bce49565d07c62a84d53cee81d8569 variable: Sepal.Width MD5: 35bd921d86f4fe19d5cadc03c687f538 variable: Petal.Length MD5: e610b9d68cb18ce39b1c0ac098e38bea variable: Petal.Width MD5: 5f70e007e1a5054816b90e5846c14467 variable: Species MD5: f7e071c073ca18cd4d0d7cf86d961dd1 > > tmpFile <- file() > summarizeDF( iris, file = tmpFile ) > tmpLines <- readLines( tmpFile ) > close( tmpFile ) > print( matrix( tmpLines, ncol = 1 ) ) [,1] [1,] "Summary of data.frame" [2,] "number of observations: 150 " [3,] "number of variables: 5 " [4,] "MD5: d3c5d071001b61a9f6131d3004fd0988 " [5,] "" [6,] "variable: Sepal.Length " [7,] "MD5: b2bce49565d07c62a84d53cee81d8569 " [8,] " [,1]" [9,] "Min. 4.300000" [10,] "1st Qu. 5.100000" [11,] "Median 5.800000" [12,] "Mean 5.843333" [13,] "3rd Qu. 6.400000" [14,] "Max. 7.900000" [15,] "" [16,] "variable: Sepal.Width " [17,] "MD5: 35bd921d86f4fe19d5cadc03c687f538 " [18,] " [,1]" [19,] "Min. 2.000000" [20,] "1st Qu. 2.800000" [21,] "Median 3.000000" [22,] "Mean 3.057333" [23,] "3rd Qu. 3.300000" [24,] "Max. 4.400000" [25,] "" [26,] "variable: Petal.Length " [27,] "MD5: e610b9d68cb18ce39b1c0ac098e38bea " [28,] " [,1]" [29,] "Min. 1.000" [30,] "1st Qu. 1.600" [31,] "Median 4.350" [32,] "Mean 3.758" [33,] "3rd Qu. 5.100" [34,] "Max. 6.900" [35,] "" [36,] "variable: Petal.Width " [37,] "MD5: 5f70e007e1a5054816b90e5846c14467 " [38,] " [,1]" [39,] "Min. 0.100000" [40,] "1st Qu. 0.300000" [41,] "Median 1.300000" [42,] "Mean 1.199333" [43,] "3rd Qu. 1.800000" [44,] "Max. 2.500000" [45,] "" [46,] "variable: Species " [47,] "MD5: f7e071c073ca18cd4d0d7cf86d961dd1 " [48,] "" [49,] " setosa versicolor virginica " [50,] " 50 50 50 " [51,] "" > > > data( "swiss" ) > > summarizeDF( swiss ) Summary of data.frame number of observations: 47 number of variables: 6 MD5: 4c43fa8a4d8f0cbf65353e397f37338c variable: Fertility MD5: 86e625283202d9a9909f099fadc690ad [,1] Min. 35.00000 1st Qu. 64.70000 Median 70.40000 Mean 70.14255 3rd Qu. 78.45000 Max. 92.50000 variable: Agriculture MD5: 5e7bdeff4cbf3e796e073fffe2b8b1f7 [,1] Min. 1.20000 1st Qu. 35.90000 Median 54.10000 Mean 50.65957 3rd Qu. 67.65000 Max. 89.70000 variable: Examination MD5: 76a910ec1c2c22996f75a051a3f90192 [,1] Min. 3.00000 1st Qu. 12.00000 Median 16.00000 Mean 16.48936 3rd Qu. 22.00000 Max. 37.00000 variable: Education MD5: fb32a176f9e7160350a18f3f58290cc6 [,1] Min. 1.00000 1st Qu. 6.00000 Median 8.00000 Mean 10.97872 3rd Qu. 12.00000 Max. 53.00000 [,1] 1 1 2 3 3 4 5 2 6 4 7 7 8 4 9 3 10 2 11 1 12 5 13 3 15 1 19 1 20 1 28 1 29 2 32 1 53 1 variable: Catholic MD5: efd14fbc7763a0ff759d5eb0b4756845 [,1] Min. 2.15000 1st Qu. 5.19500 Median 15.14000 Mean 41.14383 3rd Qu. 93.12500 Max. 100.00000 variable: Infant.Mortality MD5: 79534798b7c50423d07bc9522f11c3e4 [,1] Min. 10.80000 1st Qu. 18.15000 Median 20.00000 Mean 19.94255 3rd Qu. 21.70000 Max. 26.60000 > > summarizeDF( swiss, maxLevel = 10 ) Summary of data.frame number of observations: 47 number of variables: 6 MD5: 4c43fa8a4d8f0cbf65353e397f37338c variable: Fertility MD5: 86e625283202d9a9909f099fadc690ad [,1] Min. 35.00000 1st Qu. 64.70000 Median 70.40000 Mean 70.14255 3rd Qu. 78.45000 Max. 92.50000 variable: Agriculture MD5: 5e7bdeff4cbf3e796e073fffe2b8b1f7 [,1] Min. 1.20000 1st Qu. 35.90000 Median 54.10000 Mean 50.65957 3rd Qu. 67.65000 Max. 89.70000 variable: Examination MD5: 76a910ec1c2c22996f75a051a3f90192 [,1] Min. 3.00000 1st Qu. 12.00000 Median 16.00000 Mean 16.48936 3rd Qu. 22.00000 Max. 37.00000 variable: Education MD5: fb32a176f9e7160350a18f3f58290cc6 [,1] Min. 1.00000 1st Qu. 6.00000 Median 8.00000 Mean 10.97872 3rd Qu. 12.00000 Max. 53.00000 variable: Catholic MD5: efd14fbc7763a0ff759d5eb0b4756845 [,1] Min. 2.15000 1st Qu. 5.19500 Median 15.14000 Mean 41.14383 3rd Qu. 93.12500 Max. 100.00000 variable: Infant.Mortality MD5: 79534798b7c50423d07bc9522f11c3e4 [,1] Min. 10.80000 1st Qu. 18.15000 Median 20.00000 Mean 19.94255 3rd Qu. 21.70000 Max. 26.60000 > > summarizeDF( swiss, printValues = FALSE ) Summary of data.frame number of observations: 47 number of variables: 6 MD5: 4c43fa8a4d8f0cbf65353e397f37338c variable: Fertility MD5: 86e625283202d9a9909f099fadc690ad variable: Agriculture MD5: 5e7bdeff4cbf3e796e073fffe2b8b1f7 variable: Examination MD5: 76a910ec1c2c22996f75a051a3f90192 variable: Education MD5: fb32a176f9e7160350a18f3f58290cc6 variable: Catholic MD5: efd14fbc7763a0ff759d5eb0b4756845 variable: Infant.Mortality MD5: 79534798b7c50423d07bc9522f11c3e4 > > tmpFile <- file() > summarizeDF( swiss, file = tmpFile ) > tmpLines <- readLines( tmpFile ) > close( tmpFile ) > print( matrix( tmpLines, ncol = 1 ) ) [,1] [1,] "Summary of data.frame" [2,] "number of observations: 47 " [3,] "number of variables: 6 " [4,] "MD5: 4c43fa8a4d8f0cbf65353e397f37338c " [5,] "" [6,] "variable: Fertility " [7,] "MD5: 86e625283202d9a9909f099fadc690ad " [8,] " [,1]" [9,] "Min. 35.00000" [10,] "1st Qu. 64.70000" [11,] "Median 70.40000" [12,] "Mean 70.14255" [13,] "3rd Qu. 78.45000" [14,] "Max. 92.50000" [15,] "" [16,] "variable: Agriculture " [17,] "MD5: 5e7bdeff4cbf3e796e073fffe2b8b1f7 " [18,] " [,1]" [19,] "Min. 1.20000" [20,] "1st Qu. 35.90000" [21,] "Median 54.10000" [22,] "Mean 50.65957" [23,] "3rd Qu. 67.65000" [24,] "Max. 89.70000" [25,] "" [26,] "variable: Examination " [27,] "MD5: 76a910ec1c2c22996f75a051a3f90192 " [28,] " [,1]" [29,] "Min. 3.00000" [30,] "1st Qu. 12.00000" [31,] "Median 16.00000" [32,] "Mean 16.48936" [33,] "3rd Qu. 22.00000" [34,] "Max. 37.00000" [35,] "" [36,] "variable: Education " [37,] "MD5: fb32a176f9e7160350a18f3f58290cc6 " [38,] " [,1]" [39,] "Min. 1.00000" [40,] "1st Qu. 6.00000" [41,] "Median 8.00000" [42,] "Mean 10.97872" [43,] "3rd Qu. 12.00000" [44,] "Max. 53.00000" [45,] " [,1]" [46,] "1 1" [47,] "2 3" [48,] "3 4" [49,] "5 2" [50,] "6 4" [51,] "7 7" [52,] "8 4" [53,] "9 3" [54,] "10 2" [55,] "11 1" [56,] "12 5" [57,] "13 3" [58,] "15 1" [59,] "19 1" [60,] "20 1" [61,] "28 1" [62,] "29 2" [63,] "32 1" [64,] "53 1" [65,] "" [66,] "variable: Catholic " [67,] "MD5: efd14fbc7763a0ff759d5eb0b4756845 " [68,] " [,1]" [69,] "Min. 2.15000" [70,] "1st Qu. 5.19500" [71,] "Median 15.14000" [72,] "Mean 41.14383" [73,] "3rd Qu. 93.12500" [74,] "Max. 100.00000" [75,] "" [76,] "variable: Infant.Mortality " [77,] "MD5: 79534798b7c50423d07bc9522f11c3e4 " [78,] " [,1]" [79,] "Min. 10.80000" [80,] "1st Qu. 18.15000" [81,] "Median 20.00000" [82,] "Mean 19.94255" [83,] "3rd Qu. 21.70000" [84,] "Max. 26.60000" [85,] "" > > proc.time() user system elapsed 0.113 0.034 0.140 miscTools/tests/insertColRow.R0000644000176200001440000000334712120154110016137 0ustar liggesusers## load miscTools package library( "miscTools" ) ## create a matrix m <- matrix( 1:9, 3 ) # insert rows print( insertRow( m, 1, 10:12 ) ) print( insertRow( m, 2, 10:12 ) ) print( insertRow( m, 3, 10:12 ) ) print( insertRow( m, 4, 10:12 ) ) # insert columns print( insertCol( m, 1, 10:12 ) ) print( insertCol( m, 2, 10:12 ) ) print( insertCol( m, 3, 10:12 ) ) print( insertCol( m, 4, 10:12 ) ) # insert rows with name print( insertRow( m, 1, 10:12, "R0" ) ) print( insertRow( m, 2, 10:12, "R1a" ) ) print( insertRow( m, 3, 10:12, "R2a" ) ) print( insertRow( m, 4, 10:12, "R4" ) ) # insert columns with name print( insertCol( m, 1, 10:12, "C0" ) ) print( insertCol( m, 2, 10:12, "C1a" ) ) print( insertCol( m, 3, 10:12, "C2a" ) ) print( insertCol( m, 4, 10:12, "C4" ) ) ## add row names and column names rownames( m ) <- c( "R1", "R2", "R3" ) colnames( m ) <- c( "C1", "C2", "C3" ) # insert rows print( insertRow( m, 1, 10:12 ) ) print( insertRow( m, 2, 10:12 ) ) print( insertRow( m, 3, 10:12 ) ) print( insertRow( m, 4, 10:12 ) ) # insert columns print( insertCol( m, 1, 10:12 ) ) print( insertCol( m, 2, 10:12 ) ) print( insertCol( m, 3, 10:12 ) ) print( insertCol( m, 4, 10:12 ) ) # insert rows with name print( insertRow( m, 1, 10:12, "R0" ) ) print( insertRow( m, 2, 10:12, "R1a" ) ) print( insertRow( m, 3, 10:12, "R2a" ) ) print( insertRow( m, 4, 10:12, "R4" ) ) # insert columns with name print( insertCol( m, 1, 10:12, "C0" ) ) print( insertCol( m, 2, 10:12, "C1a" ) ) print( insertCol( m, 3, 10:12, "C2a" ) ) print( insertCol( m, 4, 10:12, "C4" ) ) # insert a row to a single-column matrix (example provided by Max Gordon) insertRow( matrix( 1:3, ncol=1 ), 2, 4 ) # insert a column to a single-row matrix insertCol( matrix( 1:3, nrow=1 ), 2, 4 ) miscTools/tests/semidefTest.Rout.save0000644000176200001440000002140613015764566017474 0ustar liggesusers R version 3.3.1 (2016-06-21) -- "Bug in Your Hair" Copyright (C) 2016 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( "miscTools" ) > > set.seed( 123 ) > > # not symmetric > m1 <- matrix( rnorm( 9 ), ncol = 3 ) > print( m1 ) [,1] [,2] [,3] [1,] -0.5604756 0.07050839 0.4609162 [2,] -0.2301775 0.12928774 -1.2650612 [3,] 1.5587083 1.71506499 -0.6868529 > try( semidefiniteness( m1 ) ) Error in isSemidefinite.matrix(m = m, ...) : argument 'm' must be a symmetric matrix > try( semidefiniteness( m1, method = "eigen" ) ) Error in isSemidefinite.matrix(m = m, ...) : argument 'm' must be a symmetric matrix > try( semidefiniteness( m1, positive = FALSE ) ) Error in isSemidefinite.matrix(m = m, ...) : argument 'm' must be a symmetric matrix > try( semidefiniteness( m1, positive = FALSE, method = "eigen" ) ) Error in isSemidefinite.matrix(m = m, ...) : argument 'm' must be a symmetric matrix > > # positive semidefinite > m2 <- crossprod( m1 ) > print( m2 ) [,1] [,2] [,3] [1,] 2.796686 2.604009 -1.037747 [2,] 2.604009 2.963135 -1.309056 [3,] -1.037747 -1.309056 2.284591 > semidefiniteness( m2 ) [1] TRUE > semidefiniteness( m2, method = "eigen" ) [1] TRUE > semidefiniteness( m2, positive = FALSE ) [1] FALSE > semidefiniteness( m2, positive = FALSE, method = "eigen" ) [1] FALSE > # negative semidefinite > semidefiniteness( -m2 ) [1] FALSE > semidefiniteness( -m2, method = "eigen" ) [1] FALSE > semidefiniteness( -m2, positive = FALSE ) [1] TRUE > semidefiniteness( -m2, positive = FALSE, method = "eigen" ) [1] TRUE > > # positive semidefinite, singular > m3 <- cbind( m2, - rowSums( m2 ) ) > m3 <- rbind( m3, - colSums( m3 ) ) > print( m3 ) [,1] [,2] [,3] [,4] [1,] 2.796686 2.604009 -1.03774694 -4.36294799 [2,] 2.604009 2.963135 -1.30905572 -4.25808763 [3,] -1.037747 -1.309056 2.28459052 0.06221214 [4,] -4.362948 -4.258088 0.06221214 8.55882348 > semidefiniteness( m3 ) [1] TRUE > semidefiniteness( m3, method = "eigen" ) [1] TRUE > semidefiniteness( m3, positive = FALSE ) [1] FALSE > semidefiniteness( m3, positive = FALSE, method = "eigen" ) [1] FALSE > > # positive semidefinite, singular, and large numbers > m4 <- m3 * 1e6 > print( m4 ) [,1] [,2] [,3] [,4] [1,] 2796686 2604009 -1037746.94 -4362947.99 [2,] 2604009 2963135 -1309055.72 -4258087.63 [3,] -1037747 -1309056 2284590.52 62212.14 [4,] -4362948 -4258088 62212.14 8558823.48 > # rcond(m4) > # det(m4) > semidefiniteness( m4 ) [1] TRUE > semidefiniteness( m4, method = "eigen" ) [1] TRUE > semidefiniteness( m4, positive = FALSE ) [1] FALSE > semidefiniteness( m4, positive = FALSE, method = "eigen" ) [1] FALSE > > # negative semidefinite, diagonal > m5 <- diag( -1, 4, 4 ) > print( m5 ) [,1] [,2] [,3] [,4] [1,] -1 0 0 0 [2,] 0 -1 0 0 [3,] 0 0 -1 0 [4,] 0 0 0 -1 > semidefiniteness( m5 ) [1] FALSE > semidefiniteness( m5, method = "eigen" ) [1] FALSE > semidefiniteness( m5, positive = FALSE ) [1] TRUE > semidefiniteness( m5, positive = FALSE, method = "eigen" ) [1] TRUE > > # negative semidefinite, singular > m6 <- matrix( -1, 4, 4 ) > print( m6 ) [,1] [,2] [,3] [,4] [1,] -1 -1 -1 -1 [2,] -1 -1 -1 -1 [3,] -1 -1 -1 -1 [4,] -1 -1 -1 -1 > semidefiniteness( m6 ) [1] FALSE > semidefiniteness( m6, method = "eigen" ) [1] FALSE > semidefiniteness( m6, positive = FALSE ) [1] TRUE > semidefiniteness( m6, positive = FALSE, method = "eigen" ) [1] TRUE > > # negative semidefinite, diagonal > m7 <- diag( c( -1, -3 ) ) > print( m7 ) [,1] [,2] [1,] -1 0 [2,] 0 -3 > semidefiniteness( m7 ) [1] FALSE > semidefiniteness( m7, method = "eigen" ) [1] FALSE > semidefiniteness( m7, positive = FALSE ) [1] TRUE > semidefiniteness( m7, positive = FALSE, method = "eigen" ) [1] TRUE > > # positive semidefinite > m8 <- symMatrix( c( 2, -1, 0, 2, -1, 2 ) ) > print( m8 ) [,1] [,2] [,3] [1,] 2 -1 0 [2,] -1 2 -1 [3,] 0 -1 2 > semidefiniteness( m8 ) [1] TRUE > semidefiniteness( m8, method = "eigen" ) [1] TRUE > semidefiniteness( m8, positive = FALSE ) [1] FALSE > semidefiniteness( m8, positive = FALSE, method = "eigen" ) [1] FALSE > > # indefinite > m9 <- symMatrix( rnorm( 6 ) ) > print( m9 ) [,1] [,2] [,3] [1,] -0.4456620 1.2240818 0.3598138 [2,] 1.2240818 0.4007715 0.1106827 [3,] 0.3598138 0.1106827 -0.5558411 > semidefiniteness( m9 ) [1] FALSE > semidefiniteness( m9, method = "eigen" ) [1] FALSE > semidefiniteness( m9, positive = FALSE ) [1] FALSE > semidefiniteness( m9, positive = FALSE, method = "eigen" ) [1] FALSE > > # positive and negative semidefinite > m10 <- matrix( 0, 3, 3 ) > print( m10 ) [,1] [,2] [,3] [1,] 0 0 0 [2,] 0 0 0 [3,] 0 0 0 > semidefiniteness( m10 ) [1] TRUE > semidefiniteness( m10, method = "eigen" ) [1] TRUE > semidefiniteness( m10, positive = FALSE ) [1] TRUE > semidefiniteness( m10, positive = FALSE, method = "eigen" ) [1] TRUE > > # indefinite > m11 <- symMatrix( 1:6 ) > print( m11 ) [,1] [,2] [,3] [1,] 1 2 3 [2,] 2 4 5 [3,] 3 5 6 > semidefiniteness( m11 ) [1] FALSE > semidefiniteness( m11, method = "eigen" ) [1] FALSE > semidefiniteness( m11, positive = FALSE ) [1] FALSE > semidefiniteness( m11, positive = FALSE, method = "eigen" ) [1] FALSE > > # indefinite, singular > m12 <- cbind( m9, - rowSums( m9 ) ) > m12 <- rbind( m12, - colSums( m12 ) ) > print( m12 ) [,1] [,2] [,3] [,4] [1,] -0.4456620 1.2240818 0.35981383 -1.13823365 [2,] 1.2240818 0.4007715 0.11068272 -1.73553596 [3,] 0.3598138 0.1106827 -0.55584113 0.08534459 [4,] -1.1382337 -1.7355360 0.08534459 2.78842503 > semidefiniteness( m12 ) [1] FALSE > semidefiniteness( m12, method = "eigen" ) [1] FALSE > semidefiniteness( m12, positive = FALSE ) [1] FALSE > semidefiniteness( m12, positive = FALSE, method = "eigen" ) [1] FALSE > > # indefinite, singular, small numbers > m13 <- m12 * 1e-6 > print( m13 ) [,1] [,2] [,3] [,4] [1,] -4.456620e-07 1.224082e-06 3.598138e-07 -1.138234e-06 [2,] 1.224082e-06 4.007715e-07 1.106827e-07 -1.735536e-06 [3,] 3.598138e-07 1.106827e-07 -5.558411e-07 8.534459e-08 [4,] -1.138234e-06 -1.735536e-06 8.534459e-08 2.788425e-06 > semidefiniteness( m13 ) [1] FALSE > semidefiniteness( m13, method = "eigen" ) [1] FALSE > semidefiniteness( m13, positive = FALSE ) [1] FALSE > semidefiniteness( m13, positive = FALSE, method = "eigen" ) [1] FALSE > > # 'large' matrix > m14 <- symMatrix( 1:( 13 * (13+1) / 2 ) ) > semidefiniteness( m14 ) [1] FALSE > semidefiniteness( m14, method = "det" ) Warning in isSemidefinite.matrix(m = m, ...) : using method 'det' can take a very long time for matrices with more than 12 rows and columns; it is suggested to use method 'eigen' for larger matrices [1] FALSE > semidefiniteness( m14, method = "eigen" ) [1] FALSE > > # list, one element not a matrix > ml1 <- list( m2, c( m1 ), m3, m4 ) > try( semidefiniteness( ml1 ) ) Error in isSemidefinite.list(m = m, ...) : all components of the list specified by argument 'm' must be matrices > > # list of matrices, one non-symmetric > ml2 <- list( m2, m1, m3, m4 ) > try( semidefiniteness( ml2 ) ) Error in isSemidefinite.matrix(m[[t]], ...) : argument 'm' must be a symmetric matrix > > # list of matrices, one 'large' matrix > ml3 <- list( m2, m14, m3, m4 ) > semidefiniteness( ml3 ) [1] TRUE FALSE TRUE TRUE > semidefiniteness( ml3, method = "det" ) Warning in isSemidefinite.matrix(m[[t]], ...) : using method 'det' can take a very long time for matrices with more than 12 rows and columns; it is suggested to use method 'eigen' for larger matrices [1] TRUE FALSE TRUE TRUE > semidefiniteness( ml3, method = "eigen" ) [1] TRUE FALSE TRUE TRUE > semidefiniteness( ml3, positive = FALSE ) [1] FALSE FALSE FALSE FALSE > semidefiniteness( ml3, positive = FALSE, method = "det" ) Warning in isSemidefinite.matrix(m[[t]], ...) : using method 'det' can take a very long time for matrices with more than 12 rows and columns; it is suggested to use method 'eigen' for larger matrices [1] FALSE FALSE FALSE FALSE > semidefiniteness( ml3, positive = FALSE, method = "eigen" ) [1] FALSE FALSE FALSE FALSE > > proc.time() user system elapsed 0.268 0.020 0.312 miscTools/tests/ddnormTest.Rout.save0000644000176200001440000000723713014055113017325 0ustar liggesusers R version 2.14.1 (2011-12-22) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( miscTools ) > > eps <- 1e-7 > > x <- (-40:40)/10 > > ## standard normal distribution > ddnorm( x ) [1] 0.0005353209 0.0007747563 0.0011093983 0.0015716870 0.0022028469 [6] 0.0030543894 0.0041895452 0.0056844775 0.0076290822 0.0101271391 [11] 0.0132955452 0.0172623440 0.0221632644 0.0281365240 0.0353157200 [16] 0.0438207512 0.0537468727 0.0651521868 0.0780441043 0.0923655516 [21] 0.1079819330 0.1246700481 0.1421102849 0.1598834315 0.1774733355 [26] 0.1942763935 0.2096184519 0.2227791697 0.2330232660 0.2396373947 [31] 0.2419707245 0.2394767249 0.2317532422 0.2185777534 0.1999347617 [36] 0.1760326634 0.1473080561 0.1144163446 0.0782085388 0.0396952547 [41] 0.0000000000 -0.0396952547 -0.0782085388 -0.1144163446 -0.1473080561 [46] -0.1760326634 -0.1999347617 -0.2185777534 -0.2317532422 -0.2394767249 [51] -0.2419707245 -0.2396373947 -0.2330232660 -0.2227791697 -0.2096184519 [56] -0.1942763935 -0.1774733355 -0.1598834315 -0.1421102849 -0.1246700481 [61] -0.1079819330 -0.0923655516 -0.0780441043 -0.0651521868 -0.0537468727 [66] -0.0438207512 -0.0353157200 -0.0281365240 -0.0221632644 -0.0172623440 [71] -0.0132955452 -0.0101271391 -0.0076290822 -0.0056844775 -0.0041895452 [76] -0.0030543894 -0.0022028469 -0.0015716870 -0.0011093983 -0.0007747563 [81] -0.0005353209 > all.equal( ddnorm(x), ( dnorm( x + eps ) - dnorm( x - eps ) ) / ( 2 * eps ) ) [1] TRUE > > ## normal distribution (non-standard) > x <- (0:100)/10 > ddnorm( x, mean = 5, sd = 2 ) [1] 0.010955188 0.012150380 0.013436718 0.014815704 0.016288047 [6] 0.017853554 0.019511026 0.021258147 0.023091388 0.025005910 [11] 0.026995483 0.029052419 0.031167512 0.033330004 0.035527571 [16] 0.037746327 0.039970858 0.042184281 0.044368334 0.046503488 [21] 0.048569098 0.050543580 0.052404613 0.054129373 0.055694792 [26] 0.057077839 0.058255816 0.059206677 0.059909349 0.060344062 [31] 0.060492681 0.060339026 0.059869181 0.059071788 0.057938311 [36] 0.056463269 0.054644438 0.052483008 0.049983690 0.047154780 [41] 0.044008166 0.040559283 0.036827014 0.032833530 0.028604086 [46] 0.024166757 0.019552135 0.014792975 0.009923814 0.004980549 [51] 0.000000000 -0.004980549 -0.009923814 -0.014792975 -0.019552135 [56] -0.024166757 -0.028604086 -0.032833530 -0.036827014 -0.040559283 [61] -0.044008166 -0.047154780 -0.049983690 -0.052483008 -0.054644438 [66] -0.056463269 -0.057938311 -0.059071788 -0.059869181 -0.060339026 [71] -0.060492681 -0.060344062 -0.059909349 -0.059206677 -0.058255816 [76] -0.057077839 -0.055694792 -0.054129373 -0.052404613 -0.050543580 [81] -0.048569098 -0.046503488 -0.044368334 -0.042184281 -0.039970858 [86] -0.037746327 -0.035527571 -0.033330004 -0.031167512 -0.029052419 [91] -0.026995483 -0.025005910 -0.023091388 -0.021258147 -0.019511026 [96] -0.017853554 -0.016288047 -0.014815704 -0.013436718 -0.012150380 [101] -0.010955188 > all.equal( ddnorm( x, mean = 5, sd = 2), + ( dnorm( x + eps, mean = 5, sd = 2 ) - dnorm( x - eps, mean = 5, sd = 2 ) ) + / ( 2 * eps ) ) [1] TRUE > > miscTools/tests/sumKeepAttrTest.Rout.save0000644000176200001440000000143613014055223020303 0ustar liggesusers R version 2.14.1 (2011-12-22) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( "miscTools" ) > > a <- 1:10 > attr( a, "min" ) <- 1 > attr( a, "max" ) <- 10 > sum(a) [1] 55 > sumKeepAttr(a) [1] 55 attr(,"min") [1] 1 attr(,"max") [1] 10 > miscTools/tests/lmMethods.Rout.save0000644000176200001440000000153313014055141017130 0ustar liggesusers R version 2.14.1 (2011-12-22) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( "miscTools" ) > > # Construct a simple OLS regression: > set.seed( 123 ) > x1 <- runif(100) > x2 <- runif(100) > y <- 3 + 4*x1 + 5*x2 + rnorm(100) > m <- lm(y~x1+x2) # estimate it > nObs(m) [1] 100 > nParam(m) [1] 3 > miscTools/tests/stdErTests.R0000644000176200001440000000056613550023151015621 0ustar liggesusers## testing stdEr() methods library( "miscTools" ) data( "cars" ) # lm() lmRes <- lm(dist ~ speed, data=cars) summary( lmRes ) round( stdEr( lmRes ), 4 ) # nls() nlsRes <- nls( dist ~ b0 + b1 * speed^b2, start = c( b0=0, b1=1, b2=1 ), data = cars ) tmp <- summary( nlsRes ) tmp$convInfo$finTol <- round( tmp$convInfo$finTol, 4 ) print( tmp ) round( stdEr( nlsRes ), 3 ) miscTools/tests/summarizeDF_tests.R0000644000176200001440000000143013550017134017160 0ustar liggesusers## testing summarizeDF() library( "miscTools" ) data( "cars" ) summarizeDF( cars ) summarizeDF( cars, maxLevel = 10 ) summarizeDF( cars, printValues = FALSE ) tmpFile <- file() summarizeDF( cars, file = tmpFile ) tmpLines <- readLines( tmpFile ) close( tmpFile ) print( matrix( tmpLines, ncol = 1 ) ) data( "iris" ) summarizeDF( iris ) summarizeDF( iris, printValues = FALSE ) tmpFile <- file() summarizeDF( iris, file = tmpFile ) tmpLines <- readLines( tmpFile ) close( tmpFile ) print( matrix( tmpLines, ncol = 1 ) ) data( "swiss" ) summarizeDF( swiss ) summarizeDF( swiss, maxLevel = 10 ) summarizeDF( swiss, printValues = FALSE ) tmpFile <- file() summarizeDF( swiss, file = tmpFile ) tmpLines <- readLines( tmpFile ) close( tmpFile ) print( matrix( tmpLines, ncol = 1 ) ) miscTools/tests/semidefTest.R0000644000176200001440000001002313015531310015753 0ustar liggesuserslibrary( "miscTools" ) set.seed( 123 ) # not symmetric m1 <- matrix( rnorm( 9 ), ncol = 3 ) print( m1 ) try( semidefiniteness( m1 ) ) try( semidefiniteness( m1, method = "eigen" ) ) try( semidefiniteness( m1, positive = FALSE ) ) try( semidefiniteness( m1, positive = FALSE, method = "eigen" ) ) # positive semidefinite m2 <- crossprod( m1 ) print( m2 ) semidefiniteness( m2 ) semidefiniteness( m2, method = "eigen" ) semidefiniteness( m2, positive = FALSE ) semidefiniteness( m2, positive = FALSE, method = "eigen" ) # negative semidefinite semidefiniteness( -m2 ) semidefiniteness( -m2, method = "eigen" ) semidefiniteness( -m2, positive = FALSE ) semidefiniteness( -m2, positive = FALSE, method = "eigen" ) # positive semidefinite, singular m3 <- cbind( m2, - rowSums( m2 ) ) m3 <- rbind( m3, - colSums( m3 ) ) print( m3 ) semidefiniteness( m3 ) semidefiniteness( m3, method = "eigen" ) semidefiniteness( m3, positive = FALSE ) semidefiniteness( m3, positive = FALSE, method = "eigen" ) # positive semidefinite, singular, and large numbers m4 <- m3 * 1e6 print( m4 ) # rcond(m4) # det(m4) semidefiniteness( m4 ) semidefiniteness( m4, method = "eigen" ) semidefiniteness( m4, positive = FALSE ) semidefiniteness( m4, positive = FALSE, method = "eigen" ) # negative semidefinite, diagonal m5 <- diag( -1, 4, 4 ) print( m5 ) semidefiniteness( m5 ) semidefiniteness( m5, method = "eigen" ) semidefiniteness( m5, positive = FALSE ) semidefiniteness( m5, positive = FALSE, method = "eigen" ) # negative semidefinite, singular m6 <- matrix( -1, 4, 4 ) print( m6 ) semidefiniteness( m6 ) semidefiniteness( m6, method = "eigen" ) semidefiniteness( m6, positive = FALSE ) semidefiniteness( m6, positive = FALSE, method = "eigen" ) # negative semidefinite, diagonal m7 <- diag( c( -1, -3 ) ) print( m7 ) semidefiniteness( m7 ) semidefiniteness( m7, method = "eigen" ) semidefiniteness( m7, positive = FALSE ) semidefiniteness( m7, positive = FALSE, method = "eigen" ) # positive semidefinite m8 <- symMatrix( c( 2, -1, 0, 2, -1, 2 ) ) print( m8 ) semidefiniteness( m8 ) semidefiniteness( m8, method = "eigen" ) semidefiniteness( m8, positive = FALSE ) semidefiniteness( m8, positive = FALSE, method = "eigen" ) # indefinite m9 <- symMatrix( rnorm( 6 ) ) print( m9 ) semidefiniteness( m9 ) semidefiniteness( m9, method = "eigen" ) semidefiniteness( m9, positive = FALSE ) semidefiniteness( m9, positive = FALSE, method = "eigen" ) # positive and negative semidefinite m10 <- matrix( 0, 3, 3 ) print( m10 ) semidefiniteness( m10 ) semidefiniteness( m10, method = "eigen" ) semidefiniteness( m10, positive = FALSE ) semidefiniteness( m10, positive = FALSE, method = "eigen" ) # indefinite m11 <- symMatrix( 1:6 ) print( m11 ) semidefiniteness( m11 ) semidefiniteness( m11, method = "eigen" ) semidefiniteness( m11, positive = FALSE ) semidefiniteness( m11, positive = FALSE, method = "eigen" ) # indefinite, singular m12 <- cbind( m9, - rowSums( m9 ) ) m12 <- rbind( m12, - colSums( m12 ) ) print( m12 ) semidefiniteness( m12 ) semidefiniteness( m12, method = "eigen" ) semidefiniteness( m12, positive = FALSE ) semidefiniteness( m12, positive = FALSE, method = "eigen" ) # indefinite, singular, small numbers m13 <- m12 * 1e-6 print( m13 ) semidefiniteness( m13 ) semidefiniteness( m13, method = "eigen" ) semidefiniteness( m13, positive = FALSE ) semidefiniteness( m13, positive = FALSE, method = "eigen" ) # 'large' matrix m14 <- symMatrix( 1:( 13 * (13+1) / 2 ) ) semidefiniteness( m14 ) semidefiniteness( m14, method = "det" ) semidefiniteness( m14, method = "eigen" ) # list, one element not a matrix ml1 <- list( m2, c( m1 ), m3, m4 ) try( semidefiniteness( ml1 ) ) # list of matrices, one non-symmetric ml2 <- list( m2, m1, m3, m4 ) try( semidefiniteness( ml2 ) ) # list of matrices, one 'large' matrix ml3 <- list( m2, m14, m3, m4 ) semidefiniteness( ml3 ) semidefiniteness( ml3, method = "det" ) semidefiniteness( ml3, method = "eigen" ) semidefiniteness( ml3, positive = FALSE ) semidefiniteness( ml3, positive = FALSE, method = "det" ) semidefiniteness( ml3, positive = FALSE, method = "eigen" ) miscTools/tests/sumKeepAttrTest.R0000644000176200001440000000014511414403203016607 0ustar liggesuserslibrary( "miscTools" ) a <- 1:10 attr( a, "min" ) <- 1 attr( a, "max" ) <- 10 sum(a) sumKeepAttr(a) miscTools/tests/margEffTest.Rout.save0000644000176200001440000000137713014055157017420 0ustar liggesusers R version 2.14.1 (2011-12-22) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( "miscTools" ) > > try( margEff( 123 ) ) Error in margEff.default(123) : there is currently no default method available > > miscTools/tests/insertColRow.Rout.save0000644000176200001440000001174313014055126017635 0ustar liggesusers R version 2.15.3 (2013-03-01) -- "Security Blanket" Copyright (C) 2013 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## load miscTools package > library( "miscTools" ) > > ## create a matrix > m <- matrix( 1:9, 3 ) > > # insert rows > print( insertRow( m, 1, 10:12 ) ) [,1] [,2] [,3] [1,] 10 11 12 [2,] 1 4 7 [3,] 2 5 8 [4,] 3 6 9 > print( insertRow( m, 2, 10:12 ) ) [,1] [,2] [,3] [1,] 1 4 7 [2,] 10 11 12 [3,] 2 5 8 [4,] 3 6 9 > print( insertRow( m, 3, 10:12 ) ) [,1] [,2] [,3] [1,] 1 4 7 [2,] 2 5 8 [3,] 10 11 12 [4,] 3 6 9 > print( insertRow( m, 4, 10:12 ) ) [,1] [,2] [,3] [1,] 1 4 7 [2,] 2 5 8 [3,] 3 6 9 [4,] 10 11 12 > > # insert columns > print( insertCol( m, 1, 10:12 ) ) [,1] [,2] [,3] [,4] [1,] 10 1 4 7 [2,] 11 2 5 8 [3,] 12 3 6 9 > print( insertCol( m, 2, 10:12 ) ) [,1] [,2] [,3] [,4] [1,] 1 10 4 7 [2,] 2 11 5 8 [3,] 3 12 6 9 > print( insertCol( m, 3, 10:12 ) ) [,1] [,2] [,3] [,4] [1,] 1 4 10 7 [2,] 2 5 11 8 [3,] 3 6 12 9 > print( insertCol( m, 4, 10:12 ) ) [,1] [,2] [,3] [,4] [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 > > # insert rows with name > print( insertRow( m, 1, 10:12, "R0" ) ) [,1] [,2] [,3] R0 10 11 12 1 4 7 2 5 8 3 6 9 > print( insertRow( m, 2, 10:12, "R1a" ) ) [,1] [,2] [,3] 1 4 7 R1a 10 11 12 2 5 8 3 6 9 > print( insertRow( m, 3, 10:12, "R2a" ) ) [,1] [,2] [,3] 1 4 7 2 5 8 R2a 10 11 12 3 6 9 > print( insertRow( m, 4, 10:12, "R4" ) ) [,1] [,2] [,3] 1 4 7 2 5 8 3 6 9 R4 10 11 12 > > # insert columns with name > print( insertCol( m, 1, 10:12, "C0" ) ) C0 [1,] 10 1 4 7 [2,] 11 2 5 8 [3,] 12 3 6 9 > print( insertCol( m, 2, 10:12, "C1a" ) ) C1a [1,] 1 10 4 7 [2,] 2 11 5 8 [3,] 3 12 6 9 > print( insertCol( m, 3, 10:12, "C2a" ) ) C2a [1,] 1 4 10 7 [2,] 2 5 11 8 [3,] 3 6 12 9 > print( insertCol( m, 4, 10:12, "C4" ) ) C4 [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 > > ## add row names and column names > rownames( m ) <- c( "R1", "R2", "R3" ) > colnames( m ) <- c( "C1", "C2", "C3" ) > > # insert rows > print( insertRow( m, 1, 10:12 ) ) C1 C2 C3 10 11 12 R1 1 4 7 R2 2 5 8 R3 3 6 9 > print( insertRow( m, 2, 10:12 ) ) C1 C2 C3 R1 1 4 7 10 11 12 R2 2 5 8 R3 3 6 9 > print( insertRow( m, 3, 10:12 ) ) C1 C2 C3 R1 1 4 7 R2 2 5 8 10 11 12 R3 3 6 9 > print( insertRow( m, 4, 10:12 ) ) C1 C2 C3 R1 1 4 7 R2 2 5 8 R3 3 6 9 10 11 12 > > # insert columns > print( insertCol( m, 1, 10:12 ) ) C1 C2 C3 R1 10 1 4 7 R2 11 2 5 8 R3 12 3 6 9 > print( insertCol( m, 2, 10:12 ) ) C1 C2 C3 R1 1 10 4 7 R2 2 11 5 8 R3 3 12 6 9 > print( insertCol( m, 3, 10:12 ) ) C1 C2 C3 R1 1 4 10 7 R2 2 5 11 8 R3 3 6 12 9 > print( insertCol( m, 4, 10:12 ) ) C1 C2 C3 R1 1 4 7 10 R2 2 5 8 11 R3 3 6 9 12 > > # insert rows with name > print( insertRow( m, 1, 10:12, "R0" ) ) C1 C2 C3 R0 10 11 12 R1 1 4 7 R2 2 5 8 R3 3 6 9 > print( insertRow( m, 2, 10:12, "R1a" ) ) C1 C2 C3 R1 1 4 7 R1a 10 11 12 R2 2 5 8 R3 3 6 9 > print( insertRow( m, 3, 10:12, "R2a" ) ) C1 C2 C3 R1 1 4 7 R2 2 5 8 R2a 10 11 12 R3 3 6 9 > print( insertRow( m, 4, 10:12, "R4" ) ) C1 C2 C3 R1 1 4 7 R2 2 5 8 R3 3 6 9 R4 10 11 12 > > # insert columns with name > print( insertCol( m, 1, 10:12, "C0" ) ) C0 C1 C2 C3 R1 10 1 4 7 R2 11 2 5 8 R3 12 3 6 9 > print( insertCol( m, 2, 10:12, "C1a" ) ) C1 C1a C2 C3 R1 1 10 4 7 R2 2 11 5 8 R3 3 12 6 9 > print( insertCol( m, 3, 10:12, "C2a" ) ) C1 C2 C2a C3 R1 1 4 10 7 R2 2 5 11 8 R3 3 6 12 9 > print( insertCol( m, 4, 10:12, "C4" ) ) C1 C2 C3 C4 R1 1 4 7 10 R2 2 5 8 11 R3 3 6 9 12 > > # insert a row to a single-column matrix (example provided by Max Gordon) > insertRow( matrix( 1:3, ncol=1 ), 2, 4 ) [,1] [1,] 1 [2,] 4 [3,] 2 [4,] 3 > > # insert a column to a single-row matrix > insertCol( matrix( 1:3, nrow=1 ), 2, 4 ) [,1] [,2] [,3] [,4] [1,] 1 4 2 3 > > proc.time() user system elapsed 0.132 0.020 0.137 miscTools/tests/colMediansTest.Rout.save0000644000176200001440000000473513014054725020130 0ustar liggesusers R version 2.14.1 (2011-12-22) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library( "miscTools" ) > > > ## matrix > m <- matrix( 1:24, nrow = 6, ncol = 4 ) > > cm1 <- colMedians( m ) > print( cm1 ) [1] 3.5 9.5 15.5 21.5 > > rm1 <- rowMedians( m ) > print( rm1 ) [1] 10 11 12 13 14 15 > > all.equal( cm1, rowMedians( t( m ) ) ) [1] TRUE > all.equal( rm1, colMedians( t( m ) ) ) [1] TRUE > > > ## data.frame > data( "Electricity", package = "Ecdat" ) > Electricity <- Electricity[ 1:20, ] > > cm2 <- colMedians( Electricity ) > print( cm2 ) cost q pl sl pk sk pf 3.09655 422.50000 7794.10000 0.21090 69.26100 0.24415 25.95070 sf 0.59860 > > rm2 <- rowMedians( Electricity ) > print( rm2 ) 1 2 3 4 5 6 7 8 4.20985 12.05485 25.04895 14.64980 20.72935 18.42610 16.34295 7.24435 9 10 11 12 13 14 15 16 11.32520 8.27460 14.17730 13.01815 22.80935 17.95680 14.06405 15.67750 17 18 19 20 15.49855 12.44370 15.61920 21.87700 > > all.equal( cm2, rowMedians( t( Electricity ) ) ) [1] TRUE > all.equal( rm2, colMedians( t( Electricity ) ) ) [1] TRUE > > # array (3 dimensions) > a3 <- array( 1:24, dim = c(4,3,2), + dimnames = list( c("a","b","c","d"), c("A","B","C"), c("x","y") ) ) > colMedians( a3 ) x y A 2.5 14.5 B 6.5 18.5 C 10.5 22.5 > all.equal( median( a3[ , "B", "y" ] ), colMedians( a3 )[ "B", "y" ] ) [1] TRUE > > # array (4 dimensions) > a4 <- array( 1:120, dim = c(5,4,3,2), + dimnames = list( c("a","b","c","d","e"), c("A","B","C","D"), + c("x","y","z"), c("Y","Z") ) ) > colMedians( a4 ) , , Y x y z A 3 23 43 B 8 28 48 C 13 33 53 D 18 38 58 , , Z x y z A 63 83 103 B 68 88 108 C 73 93 113 D 78 98 118 > all.equal( median( a4[ , "B", "x", "Z" ] ), colMedians( a4 )[ "B", "x", "Z" ] ) [1] TRUE > miscTools/tests/colMediansTest.R0000644000176200001440000000173411344461701016437 0ustar liggesuserslibrary( "miscTools" ) ## matrix m <- matrix( 1:24, nrow = 6, ncol = 4 ) cm1 <- colMedians( m ) print( cm1 ) rm1 <- rowMedians( m ) print( rm1 ) all.equal( cm1, rowMedians( t( m ) ) ) all.equal( rm1, colMedians( t( m ) ) ) ## data.frame data( "Electricity", package = "Ecdat" ) Electricity <- Electricity[ 1:20, ] cm2 <- colMedians( Electricity ) print( cm2 ) rm2 <- rowMedians( Electricity ) print( rm2 ) all.equal( cm2, rowMedians( t( Electricity ) ) ) all.equal( rm2, colMedians( t( Electricity ) ) ) # array (3 dimensions) a3 <- array( 1:24, dim = c(4,3,2), dimnames = list( c("a","b","c","d"), c("A","B","C"), c("x","y") ) ) colMedians( a3 ) all.equal( median( a3[ , "B", "y" ] ), colMedians( a3 )[ "B", "y" ] ) # array (4 dimensions) a4 <- array( 1:120, dim = c(5,4,3,2), dimnames = list( c("a","b","c","d","e"), c("A","B","C","D"), c("x","y","z"), c("Y","Z") ) ) colMedians( a4 ) all.equal( median( a4[ , "B", "x", "Z" ] ), colMedians( a4 )[ "B", "x", "Z" ] ) miscTools/tests/stdErTests.Rout.save0000644000176200001440000000417513550023212017304 0ustar liggesusers R version 3.6.1 (2019-07-05) -- "Action of the Toes" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## testing stdEr() methods > library( "miscTools" ) > data( "cars" ) > > # lm() > lmRes <- lm(dist ~ speed, data=cars) > summary( lmRes ) Call: lm(formula = dist ~ speed, data = cars) Residuals: Min 1Q Median 3Q Max -29.069 -9.525 -2.272 9.215 43.201 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -17.5791 6.7584 -2.601 0.0123 * speed 3.9324 0.4155 9.464 1.49e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 15.38 on 48 degrees of freedom Multiple R-squared: 0.6511, Adjusted R-squared: 0.6438 F-statistic: 89.57 on 1 and 48 DF, p-value: 1.49e-12 > round( stdEr( lmRes ), 4 ) (Intercept) speed 6.7584 0.4155 > > # nls() > nlsRes <- nls( dist ~ b0 + b1 * speed^b2, start = c( b0=0, b1=1, b2=1 ), + data = cars ) > tmp <- summary( nlsRes ) > tmp$convInfo$finTol <- round( tmp$convInfo$finTol, 4 ) > print( tmp ) Formula: dist ~ b0 + b1 * speed^b2 Parameters: Estimate Std. Error t value Pr(>|t|) b0 5.4878 10.6846 0.514 0.60992 b1 0.2612 0.4847 0.539 0.59248 b2 1.7875 0.5553 3.219 0.00233 ** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 15.19 on 47 degrees of freedom Number of iterations to convergence: 7 Achieved convergence tolerance: 0 > round( stdEr( nlsRes ), 3 ) b0 b1 b2 10.685 0.485 0.555 > > proc.time() user system elapsed 0.118 0.032 0.143 miscTools/tests/margEffTest.R0000644000176200001440000000005711642317616015733 0ustar liggesuserslibrary( "miscTools" ) try( margEff( 123 ) ) miscTools/NEWS0000644000176200001440000000651713573131244012741 0ustar liggesusersTHIS IS THE CHANGELOG OF THE "miscTools" PACKAGE Please note that only the most significant changes are reported here. A full ChangeLog is available in the log messages of the SVN repository on R-Forge. CHANGES IN VERSION 0.6-26 (2019-12-08) * internal improvements to make the miscTools package compatible with R 4.0.0 CHANGES IN VERSION 0.6-24 (2019-10-11) * added function summarizeDF() * significantly reduced the computation time of isSemidefinite.matrix( , method = "eigen" ) if the matrix is (nearly) singular * moved function logDataSet() to package "micEcon" CHANGES IN VERSION 0.6-22 (2016-11-25) * function isSemidefinite() is a 'generic' function now, currently with methods for objects of class 'matrix' and 'list' * isSemidefinite.matrix() now immediately returns 'FALSE' as soon as a condition for positive semidefiniteness (or for negative semidefiniteness if argument 'positive' is 'FALSE') is violated, because in this case checking further conditions is irrelevant * isSemidefinite.matrix(): the default method for checking semidefiniteness of matrices with 13 or more rows/coulmns is "eigen" instead of "det" now, because method "det" can be very slow for larger matrices CHANGES IN VERSION 0.6-20 (2016-11-20) * improved function semidefiniteness() and its documentation * added function isSemidefinite(), which is currently just an additional (identical) user interface to semidefiniteness(), but which may replace semidefiniteness() in the (not so near) future CHANGES IN VERSION 0.6-16 (2013-03-13) * fixed bugs in insertCol() and insertRwo() that occurred when inserting a column to a single-row matrix or inserting a row to a single-column matrix (bug reported and solution provided by Max Gordon -- Thanks a lot!) CHANGES IN VERSION 0.6-14 (2012-12-26) * corrected bug in compPlot(): the 45-degree-line was not always drawn if the axes had logarithmic scales * compPlot() now uses informative labels of the axes by labelling the axes with the expressions that are used for specifying the objects in the call (before, the axes were always labelled by "x" and "y", respectively) CHANGES IN VERSION 0.6-12 (2011-11-12) * added generic function margEff() CHANGES IN VERSION 0.6-10 (2010-10-15) * stdEr.default() now checks for x$std only if x is an object of S3 class CHANGES IN VERSION 0.6-8 (2010-09-02) * moved generic function stdEr() including a default method and a method for objects of class "lm" from the "maxLik" package to this package CHANGES IN VERSION 0.6-6 * added generic functions nObs() and nParam() including the "default" methods and methods for objects of class "lm"; these generic functions and their methods were moved from the "maxLik" package to this package * added function ddnorm(), which calculates the derivative(s) of the density function of the normal (Gaussian) distribution with respect to the quantile * added function sumKeepAttr() that returns the sum of an array while keeping its attributes CHANGES IN VERSION 0.6-2 * added function "logDataSet", which was formerly part of the "micEcon" package, where it had the name ".micEconLogData" * function "colMedians" can return the medians of each non-row of an *array* now miscTools/R/0000755000176200001440000000000013573133131012427 5ustar liggesusersmiscTools/R/ddnorm.R0000644000176200001440000000034111403431243014026 0ustar liggesusers## derivatives of the density function of the normal distribution ## with respect to x ddnorm <- function( x, mean = 0, sd = 1 ) { deriv <- - dnorm( x = x, mean = mean, sd = sd ) * ( x - mean ) / sd^2 return( deriv ) } miscTools/R/nParam.R0000644000176200001440000000033011400734514013763 0ustar liggesusers## Return the #of parameters of model nParam <- function(x, free=FALSE, ...) UseMethod("nParam") nParam.default <- function(x, ...) x$param$nParam nParam.lm <- function(x, ...) length(coefficients(x)) miscTools/R/utils.R0000755000176200001440000001653713573130664013741 0ustar liggesusers## ----- insert a column into a matrix -------------- insertCol <- function( m, c, v = NA, cName = "" ) { # checking the argument 'm' if( !inherits( m, "matrix" ) ) { stop( "argument 'm' must be a matrix" ) } # checking the argument 'c' if( c == as.integer( c ) ) { c <- as.integer( c ) } else { stop( "argument 'c' must be an integer" ) } if( length( c ) != 1 ) { stop( "argument 'c' must be a scalar" ) } if( c < 1 ) { stop( "argument 'c' must be positive" ) } if( c > ncol( m ) + 1 ) { stop( "argument 'c' must not be larger than the number of columns", " of matrix 'm' plus one" ) } # checking the argument 'cName' if( !is.character( cName ) ) { stop( "argument 'cName' must be a character string" ) } if( length( cName ) != 1 ) { stop( "argument 'cName' must be a be a single character string" ) } nr <- nrow( m ) nc <- ncol( m ) cNames <- colnames( m ) if( is.null( cNames ) & cName != "" ) { cNames <- rep( "", nc ) } if( c == 1 ) { m2 <- cbind( matrix( v, nrow = nr ), m ) if( !is.null( cNames ) ) { colnames( m2 ) <- c( cName, cNames ) } } else if( c == nc + 1 ) { m2 <- cbind( m, matrix( v, nrow = nr ) ) if( !is.null( cNames ) ) { colnames( m2 ) <- c( cNames, cName ) } } else { m2 <- cbind( m[ , 1:( c - 1 ), drop = FALSE ], matrix( v, nrow = nr ), m[ , c:nc, drop = FALSE ] ) if( !is.null( cNames ) ) { colnames( m2 ) <- c( cNames[ 1:( c - 1 ) ], cName, cNames[ c:nc ] ) } } return( m2 ) } ## ----- insert a row into a matrix -------------- insertRow <- function( m, r, v = NA, rName = "" ) { # checking the argument 'm' if( !inherits( m, "matrix" ) ) { stop( "argument 'm' must be a matrix" ) } # checking the argument 'r' if( r == as.integer( r ) ) { r <- as.integer( r ) } else { stop( "argument 'r' must be an integer" ) } if( length( r ) != 1 ) { stop( "argument 'r' must be a scalar" ) } if( r < 1 ) { stop( "argument 'r' must be positive" ) } if( r > nrow( m ) + 1 ) { stop( "argument 'r' must not be larger than the number of rows", " of matrix 'm' plus one" ) } # checking the argument 'rName' if( !is.character( rName ) ) { stop( "argument 'rName' must be a character string" ) } if( length( rName ) != 1 ) { stop( "argument 'rName' must be a be a single character string" ) } nr <- nrow( m ) nc <- ncol( m ) rNames <- rownames( m ) if( is.null( rNames ) & rName != "" ) { rNames <- rep( "", nr ) } if( r == 1 ) { m2 <- rbind( matrix( v,ncol = nc ), m ) if( !is.null( rNames ) ) { rownames( m2 ) <- c( rName, rNames ) } } else if( r == nr + 1 ) { m2 <- rbind( m, matrix( v,ncol = nc ) ) if( !is.null( rNames ) ) { rownames( m2 ) <- c( rNames, rName ) } } else { m2 <- rbind( m[ 1:( r - 1 ), , drop = FALSE ], matrix( v, ncol = nc ), m[ r:nr, , drop = FALSE ] ) if( !is.null( rNames ) ) { rownames( m2 ) <- c( rNames[ 1:( r - 1 ) ], rName, rNames[ r:nr ] ) } } return( m2 ) } ## ----- test a bordered Hessian for quasiconcavity ------------ quasiconcavity <- function( m, tol = .Machine$double.eps ) { if( is.list( m ) ) { result <- logical( length( m ) ) for( t in 1:length( m ) ) { result[ t ] <- quasiconcavity( m[[ t ]] ) } } else { if( !is.matrix( m ) ) { stop( "argument 'm' must be a matrix" ) } if( nrow( m ) != ncol( m ) ) { stop( "argument 'm' must be a _quadratic_ matrix" ) } if( nrow( m ) < 2 ) { stop( "a bordered Hessian has at least 2 columns/rows" ) } if( m[ 1, 1 ] != 0 ) { stop( "element [1,1] of a bordered Hessian must be 0" ) } n <- nrow( m ) result <- TRUE for( i in 2:n ) { result <- result && det( m[ 1:i, 1:i ] ) * ( -1 )^i <= tol } } return( result ) } ## ----- test a bordered Hessian for quasiconvexity ------------ quasiconvexity <- function( m, tol = .Machine$double.eps ) { if( is.list( m ) ) { result <- logical( length( m ) ) for( t in 1:length( m ) ) { result[ t ] <- quasiconvexity( m[[ t ]] ) } } else { if( !is.matrix( m ) ) { stop( "argument 'm' must be a matrix" ) } if( nrow( m ) != ncol( m ) ) { stop( "argument 'm' must be a _quadratic_ matrix" ) } if( nrow( m ) < 2 ) { stop( "a bordered Hessian has at least 2 columns/rows" ) } if( m[ 1, 1 ] != 0 ) { stop( "element [1,1] of a bordered Hessian must be 0" ) } n <- nrow( m ) result <- TRUE for( i in 2:n ) { result <- result && det( m[ 1:i, 1:i ] ) <= tol } } return( result ) } ## ----- Calculation of R2 value ------------ rSquared <- function( y, resid ) { yy <- y - matrix( mean( y ), nrow = nrow( array( y ) ) ) r2 <- 1 -( t( resid ) %*% resid ) / ( t( yy ) %*% yy ) return( r2 ) } ## --- creates a symmetric matrix ---- symMatrix <- function( data = NA, nrow = NULL, byrow = FALSE, upper = FALSE ) { nData <- length( data ) if( is.null( nrow ) ) { nrow <- ceiling( -0.5 + ( 0.25 + 2 * nData )^0.5 - .Machine$double.eps^0.5 ) } nElem <- round( nrow * ( nrow + 1 ) / 2 ) if( nData < nElem ) { nRep <- nElem / nData data <- rep( data, ceiling( nRep ) )[ 1:nElem ] if( round( nRep ) != nRep ) { warning( "number of required values [", nElem, "] is not a multiple of data length [", nData, "]" ) } } if( nData > nElem ) { data <- data[ 1:nElem ] warning( "data length [", nData, "] is greater than number of ", "required values [", nElem, "]" ) } result <- matrix( NA, nrow = nrow, ncol = nrow ) if( byrow != upper ) { result[ upper.tri( result, diag = TRUE ) ] <- data result[ lower.tri( result ) ] <- t( result )[ lower.tri( result ) ] } else { result[ lower.tri( result, diag = TRUE ) ] <- data result[ upper.tri( result ) ] <- t( result )[ upper.tri( result ) ] } return( result ) } ## --- creates an upper triangular matrix from a vector ---- triang <- function( v, n ) { m <- array( 0, c( n, n ) ) r <- ( n + 1 ) * n / 2 - dim( array( v ) ) for( i in 1:( n - r ) ) { for( j in i:n ) { m[ i, j ] <- v[ veclipos( i, j, n ) ] } } return( m ) } ## creates a vector of linear indep. values from a symmetric matrix (of full rank) vecli <- function( m ) { n <- dim( m )[ 1 ] v <- array( 0, c( ( n + 1 ) * n / 2 ) ) for( i in 1:n ) { for( j in i:n ) { v[ veclipos( i, j, n ) ] <- m[ i, j ] } } return( v ) } ## creates a matrix from a vector of linear independent values vecli2m <- function( v ) { nv <- dim( array( v ) ) nm <- round( -0.5 + ( 0.25 + 2 * nv )^0.5 ) m <- array( NA, c( nm, nm ) ) for( i in 1:nm ) { for( j in 1:nm ) { m[ i, j ] <- v[ veclipos( i, j, nm ) ] } } return( m ) } ## calculation of the place of matrix elements in a vector of linear indep. values veclipos <- function( i, j, n ) { pos <- n * ( n - 1 ) / 2 - ( ( n - min( i, j ) ) * ( n - min( i, j ) + 1 ) / 2 ) + max( i, j ) return( pos ) } miscTools/R/stdEr.R0000644000176200001440000000107211437705522013641 0ustar liggesusers### methods for extracting standard errors from the models stdEr <- function(x, ...) ## Extract standard deviations from models (as coefficients) UseMethod("stdEr") stdEr.default <- function(x, ...) { if( !isS4( x ) ) { if( !is.null( x$std ) ) { return(x$std) } } if(!is.null(vc <- vcov(x))) { s <- sqrt(diag(vc)) names(s) <- names(coef(x)) return(s) } return(NULL) # if neither std nor vcov is defined, we return NULL... } stdEr.lm <- function(x, ...) sqrt(diag(vcov(x))) miscTools/R/coefTable.R0000644000176200001440000000067411315172500014440 0ustar liggesuserscoefTable <- function( coef, stdErr, df = NULL ) { result <- cbind( coef, stdErr, coef / stdErr, rep( NA, length( coef ) ) ) if( !is.null( df ) ) { result[ , 4 ] <- 2 * pt( abs( coef / stdErr ), df, lower.tail = FALSE ) } colnames( result ) <- c( "Estimate", "Std. Error", "t value", "Pr(>|t|)" ) if( !is.null( names( coef ) ) ) { rownames( result ) <- names( coef ) } return( result ) }miscTools/R/compPlot.R0000644000176200001440000000220712066361274014357 0ustar liggesuserscompPlot <- function( x, y, lim = NULL, ... ) { xyRange <- range( x, y, na.rm = TRUE, finite = TRUE ) if( is.null( lim ) ) { lim <- xyRange } else { if( length( lim ) != 2 ) { stop( "argument 'lim' must be a vector of two elements" ) } if( is.na( lim[1] ) ) { lim[1] <- xyRange[1] } if( is.na( lim[2] ) ) { lim[2] <- xyRange[2] } if( lim[1] >= lim[2] ) { stop( "the first element of argument 'lim' must be smaller", " than the second element" ) } if( lim[1] > xyRange[1] | lim[2] < xyRange[2] ) { warning( "some data points are outside the print area" ) } } # code taken from plot.default() xlabel <- deparse(substitute(x)) ylabel <- deparse(substitute(y)) argList <- list( ... ) argList$x <- x argList$y <- y argList$xlim <- lim argList$ylim <- lim if( ! "xlab" %in% names (argList) ) { argList$xlab <- xlabel } if( ! "ylab" %in% names (argList) ) { argList$ylab <- ylabel } do.call( plot.default, argList ) abline( 0, 1 ) invisible( xyRange ) } miscTools/R/colMedians.R0000644000176200001440000000166111344460160014633 0ustar liggesuserscolMedians <- function( x, na.rm = FALSE ) { if( is.data.frame( x ) ) { x <- as.matrix( x ) } if( !is.array( x ) ) { stop( "argument 'x' must be a data.frame, matrix, or array" ) } if( !is.numeric( x ) ) { stop( "argument 'x' must be numeric" ) } result <- array( NA, dim = dim( x )[-1] ) dimnames( result ) <- dimnames( x )[-1] for( i in 1:dim( x )[ 2 ] ) { if( length( dim( x ) ) == 2 ) { result[ i ] <- median( x[ , i ], na.rm = na.rm ) } else { result[ slice.index( result, 1 ) == i ] <- colMedians( array( x[ slice.index( x, 2 ) == i ], dim = dim( x )[ -2 ] ), na.rm = na.rm ) } } return( result ) } rowMedians <- function( x, na.rm = FALSE ) { if( is.null( dim( x ) ) || length( dim( x ) ) != 2 ) { stop( "argument 'x' must be a matrix or a data.frame" ) } return( colMedians( t( x ), na.rm = na.rm ) ) } miscTools/R/nObs.R0000644000176200001440000000035511400730177013456 0ustar liggesusers## Return #of observations for models nObs <- function(x, ...) ## Number of observations for statistical models UseMethod("nObs") nObs.lm <- function(x, ...) nrow(x$qr$qr) nObs.default <- function(x, ...) x$param$nObs miscTools/R/semidef.R0000755000176200001440000000646213034447177014213 0ustar liggesusersisSemidefinite <- function( m, ... ) UseMethod( "isSemidefinite" ) isSemidefinite.default <- function( m, ... ) { stop( "there is currently no default method available" ) } ## ----- test positive / negative semidefiniteness isSemidefinite.matrix <- function( m, positive = TRUE, tol = 100 * .Machine$double.eps, method = ifelse( nrow( m ) < 13, "det", "eigen" ), ... ) { if( !is.matrix( m ) ) { stop( "argument 'm' must be a matrix" ) } else { if( nrow( m ) != ncol( m ) ) { stop( "argument 'm' or each of its elements must be a _quadratic_ matrix" ) } else if( !isSymmetric( unname( m ), tol = 1000 * tol ) ) { stop( "argument 'm' must be a symmetric matrix" ) } # make sure that the matrix is almost exactly symmetric # even if it is slightly non-symmetric m <- ( m + t(m) ) / 2 n <- nrow( m ) if( !positive ) { m <- -m } if( n >= 12 && method == "det" ) { warning( "using method 'det' can take a very long time", " for matrices with more than 12 rows and columns;", " it is suggested to use method 'eigen' for larger matrices", immediate. = TRUE ) } if( method == "det" ) { for( i in 1:n ) { comb <- combn( n, i ) for( j in 1:ncol( comb ) ) { mat <- m[ comb[ , j ], comb[ , j ], drop = FALSE ] if( rcond( mat ) >= tol ) { princMin <- det( mat ) } else { princMin <- 0 } if( princMin < -tol ) { return( FALSE ) } } } return( TRUE ) } else if( method == "eigen" ) { ev <- eigen( m, only.values = TRUE )$values if( is.complex( ev ) ) { stop( "complex (non-real) eigenvalues,", " which could be caused by a non-symmetric matrix" ) } if( all( ev > -tol ) ) { return( TRUE ) } else { if( rcond( m ) >= tol || n == 1 ) { return( FALSE ) } else { k <- max( 1, min( sum( abs( ev ) <= tol ), n - 1 ) ) comb <- combn( n, n-k ) for( j in 1:ncol( comb ) ) { mm <- m[ comb[ , j ], comb[ , j ], drop = FALSE ] if( !semidefiniteness( mm, tol = tol, method = method ) ) { return( FALSE ) } } return( TRUE ) } } } else { stop( "argument 'method' must be either 'det' or 'eigen'" ) } } stop( "internal error: please inform the maintainer", " of the 'miscTools' package", " (preferably with a reproducible example)" ) } isSemidefinite.list <- function( m, ... ) { if( !is.list( m ) ) { stop( "argument 'm' must be a matrix or a list of matrices" ) } else if( !all( sapply( m, is.matrix ) ) ) { stop( "all components of the list specified by argument 'm'", " must be matrices" ) } result <- logical( length( m ) ) for( t in 1:length( m ) ) { result[ t ] <- isSemidefinite( m[[ t ]], ... ) } return( result ) } semidefiniteness <- function( m, ... ) { result <- isSemidefinite( m = m, ... ) return( result ) } miscTools/R/sumKeepAttr.R0000644000176200001440000000043611414402624015017 0ustar liggesusers## return the sum of an array while keeping its attributes sumKeepAttr <- function( x, keepNames = FALSE, na.rm = FALSE ) { xAttr <- attributes( x ) if( !keepNames ) { xAttr$names <- NULL } x <- sum( x, na.rm = na.rm ) mostattributes( x ) <- xAttr return( x ) } miscTools/R/summarizeDF.R0000644000176200001440000000327213550016303015000 0ustar liggesuserssummarizeDF <- function( dat, printValues = TRUE, maxLevel = 20, file = NULL, ... ) { if( !inherits( dat, "data.frame" ) ) { stop( "argument 'dat' must be a data.frame" ) } if( !is.null( file ) ) { sink( file = file, ... ) } cat( "Summary of data.frame\n" ) cat( "number of observations:", nrow(dat), "\n" ) cat( "number of variables:", ncol(dat), "\n" ) cat( "MD5:", digest(dat), "\n\n" ) for( i in 1:length( dat ) ) { cat( "variable:", names( dat )[i], "\n" ) cat( "MD5:", digest(dat[[i]]), "\n" ) if( isTRUE( printValues ) ) { if( is.numeric( dat[[i]] ) ) { print( cbind( summary( dat[[i]] ) ) ) if( length( unique( dat[[i]] ) ) <= maxLevel ) { print( cbind( table( dat[[i]], useNA = "ifany" ) ) ) } } else if( is.character( dat[[i]] ) & length( unique( dat[[i]] ) ) <= maxLevel ) { print( cbind( table( dat[[i]], useNA = "ifany" ) ) ) } else if( is.factor( dat[[i]] ) ) { if( length( levels( dat[[i]] )) <= maxLevel ) { print( table( dat[[i]], useNA = "ifany" ) ) } } else if( is.logical( dat[[i]] ) ) { print( table( dat[[i]], useNA = "ifany" ) ) } } else if( printValues == "mean+sd" ) { if( is.numeric( dat[[i]] ) ) { cat( "mean:", mean( dat[[i]], na.rm = TRUE ), "\n") cat( "sd:", sd( dat[[i]], na.rm = TRUE ), "\n" ) if( sum( is.na( dat[[i]] ) ) > 0 ) { cat( "NAs:", sum( is.na( dat[[i]] ) ), "\n" ) } } } cat( "\n" ) } if( !is.null( file ) ) { sink( ) } } miscTools/R/margEff.R0000644000176200001440000000027411642320342014121 0ustar liggesusersmargEff <- function( object, ... ) UseMethod( "margEff" ) # default method margEff.default <- function( object, ... ) { stop( "there is currently no default method available" ) } miscTools/R/checkNames.R0000644000176200001440000000036511315172500014612 0ustar liggesuserscheckNames <- function( testNames, allNames ) { inAllNames <- testNames %in% allNames if( !all( inAllNames ) ) { stop( "object(s) '", paste( testNames[ !inAllNames ], collapse = "', '" ), "' not found." ) } } miscTools/MD50000644000176200001440000000554713573136753012566 0ustar liggesusers8176fb0829a42968ae41b22570ff949a *DESCRIPTION 894269651437d2bb812740641543c814 *NAMESPACE d97951b629891958465272899b96513b *NEWS e3babd76fec6b1c5ab4604f68d45ef1c *R/checkNames.R 252d30d0a896bd1b9f0bf942c72181b5 *R/coefTable.R d50ca2328c07306b8f5c35e22911ffc7 *R/colMedians.R 2aeaa005d2bb31a30b3388430127ebb9 *R/compPlot.R fbc8147e79f22b1e16543a8b02df41d6 *R/ddnorm.R 5c6bf1348fbafd09c133c6837bda7d7f *R/margEff.R 486e412f9aed7a22cf4af6a2fb0d8efb *R/nObs.R 959fd81d0615a9e57c21035e51368c80 *R/nParam.R 2c946d2e8911b6f5975328d430b7c2ff *R/semidef.R 0ffc45f50a2545ebd525b6d23e66ec56 *R/stdEr.R b3885cebbf5692eb72ec9c281abe08ae *R/sumKeepAttr.R c3a6c3835ddc5a30e97d43be7ed1612a *R/summarizeDF.R ef1a8659c7282dc1f0e1f652eddefdb3 *R/utils.R 7ad229468f5cedbfbe3f849bfe6c5ead *man/coefTable.Rd 47e3a3a8db4cfd543ca55cd6b4d6f572 *man/colMedians.Rd b22d0e29109dc4e507b57323bd9ccef0 *man/compPlot.Rd d81195d8b3263e2b5c7a3f33d9a797d7 *man/ddnorm.Rd 0624b7972bac719599ba9b56aed17da2 *man/insertCol.Rd b4fa613af374d57ee9167bcf42d288a0 *man/insertRow.Rd 7efcf21ca105106105497dc0c470e376 *man/margEff.Rd d43c131095619b781aea4deeed1ad276 *man/miscTools-internal.Rd 1b3046f8fb6b9e044ead795e782eed75 *man/nObs.Rd c01313e697ec6d374c55ba69cc1c4ef5 *man/nParam.Rd fe933136168a3f27476ca13f64b86413 *man/quasiconcavity.Rd 02f6f6e809b64e9c1415765ad83d95b0 *man/rSquared.Rd f786c67daf28b8336a4a73c791f20817 *man/rowMedians.Rd 90ac1cf8002cf4810aa8f6f39d3c3cc4 *man/semidefiniteness.Rd c593269b216697ea39ef815876c5f2d9 *man/stdEr.Rd 9ad446f2d2b4b0230823b556445838f2 *man/sumKeepAttr.Rd e7fd8cb44e4ef27ce06b6a539848c315 *man/summarizeDF.Rd e44711f81ae1a2874851ee957e13fbe9 *man/symMatrix.Rd de238aefc895618febb71c33afce934a *man/triang.Rd 3f535b4a31b6dc0e10d299c056f482e5 *man/vecli.Rd 78bf58648a9eb3be3f26c56a5a4e5749 *man/vecli2m.Rd a1c518e2a5fdb4218ffb69753a15771a *man/veclipos.Rd 6147ee88f55cf916aaca252406a8e0fc *tests/colMediansTest.R 26324aa3d747952b7acd1ddebd63e053 *tests/colMediansTest.Rout.save 705cd0fb4ca32db70b61bd56c84ae045 *tests/ddnormTest.R 7e7793188f25d50d4659989fc34ea68f *tests/ddnormTest.Rout.save 04fd109804cbdad7e0e75b20bd85a510 *tests/insertColRow.R 5ae62bf676306eb226435780f2a99c68 *tests/insertColRow.Rout.save 85b0fa5dedf7ecffa8b0220003993517 *tests/lmMethods.R dc20fe1046d7df901b9fcb47a0b174ba *tests/lmMethods.Rout.save 608d7c2980b50689700ca4f0d3a37e3f *tests/margEffTest.R 4eb1827f427348a5b2dd142e11bbee3d *tests/margEffTest.Rout.save 70bb62558d457fc8f84f1284c287b6ca *tests/semidefTest.R 42f4fbf04634d1f366f71911b1250b11 *tests/semidefTest.Rout.save 27c11537722e22d11991879893c148d7 *tests/stdErTests.R 91132264d8f45224332e32a16c064536 *tests/stdErTests.Rout.save 3383c0c8b0b4191bddfb7f1d4f59e9e1 *tests/sumKeepAttrTest.R 757f1c6e3472103b69dcba9d6e5c50b2 *tests/sumKeepAttrTest.Rout.save b2ac54b855f592e0e3fe86bf7f4f1154 *tests/summarizeDF_tests.R cb0bfa4787a5d8f21c2075ad1af451bf *tests/summarizeDF_tests.Rout.save