miscTools/0000755000175100001440000000000013016034471012243 5ustar hornikusersmiscTools/tests/0000755000175100001440000000000013015765714013417 5ustar hornikusersmiscTools/tests/ddnormTest.R0000644000175100001440000000062311403434315015653 0ustar hornikuserslibrary( 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/margEffTest.R0000644000175100001440000000005711642317616015751 0ustar hornikuserslibrary( "miscTools" ) try( margEff( 123 ) ) miscTools/tests/margEffTest.Rout.save0000644000175100001440000000137713014055157017436 0ustar hornikusers 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/sumKeepAttrTest.Rout.save0000644000175100001440000000143613014055223020321 0ustar hornikusers 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/sumKeepAttrTest.R0000644000175100001440000000014511414403203016625 0ustar hornikuserslibrary( "miscTools" ) a <- 1:10 attr( a, "min" ) <- 1 attr( a, "max" ) <- 10 sum(a) sumKeepAttr(a) miscTools/tests/colMediansTest.R0000644000175100001440000000173411344461701016455 0ustar hornikuserslibrary( "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/insertColRow.R0000644000175100001440000000334712120154110016155 0ustar hornikusers## 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.R0000644000175100001440000001002313015531310015771 0ustar hornikuserslibrary( "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/stdErTests.Rout.save0000644000175100001440000000405613014054701017322 0ustar hornikusers 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. > ## 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 > stdEr( lmRes ) (Intercept) speed 6.7584402 0.4155128 > > # nls() > nlsRes <- nls( dist ~ b0 + b1 * speed^b2, start = c( b0=0, b1=1, b2=1 ), + data = cars ) > summary( nlsRes ) 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: 3.388e-06 > stdEr( nlsRes ) b0 b1 b2 10.6845856 0.4846584 0.5553006 > > proc.time() user system elapsed 0.152 0.012 0.166 miscTools/tests/insertColRow.Rout.save0000644000175100001440000001174313014055126017653 0ustar hornikusers 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/semidefTest.Rout.save0000644000175100001440000002140613015764566017512 0ustar hornikusers 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/colMediansTest.Rout.save0000644000175100001440000000473513014054725020146 0ustar hornikusers 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/lmMethods.R0000644000175100001440000000030311400734530015456 0ustar hornikuserslibrary( "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/stdErTests.R0000644000175100001440000000041511437676431015651 0ustar hornikusers## testing stdEr() methods library( miscTools ) data(cars) # lm() lmRes <- lm(dist ~ speed, data=cars) summary( lmRes ) stdEr( lmRes ) # nls() nlsRes <- nls( dist ~ b0 + b1 * speed^b2, start = c( b0=0, b1=1, b2=1 ), data = cars ) summary( nlsRes ) stdEr( nlsRes ) miscTools/tests/ddnormTest.Rout.save0000644000175100001440000000723713014055113017343 0ustar hornikusers 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/lmMethods.Rout.save0000644000175100001440000000153313014055141017146 0ustar hornikusers 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/NAMESPACE0000644000175100001440000000217113015521114013455 0ustar hornikusersexport( "checkNames" ) export( "coefTable" ) export( "colMedians" ) export( "rowMedians" ) export( "compPlot" ) export( "ddnorm" ) export( "insertCol" ) export( "insertRow" ) export( "isSemidefinite" ) export( "logDataSet" ) export( "margEff" ) export( "nObs" ) export( "nParam" ) export( "quasiconcavity" ) export( "quasiconvexity" ) export( "rSquared" ) export( "semidefiniteness" ) export( "stdEr" ) export( "sumKeepAttr" ) 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( "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( "utils", "combn" ) miscTools/NEWS0000644000175100001440000000563413015765541012762 0ustar hornikusersTHIS 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-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/0000755000175100001440000000000013015765714012456 5ustar hornikusersmiscTools/R/utils.R0000755000175100001440000001653313014064256013744 0ustar hornikusers## ----- insert a column into a matrix -------------- insertCol <- function( m, c, v = NA, cName = "" ) { # checking the argument 'm' if( class( 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( class( 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/semidef.R0000755000175100001440000000611113015764436014217 0ustar hornikusersisSemidefinite <- 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" ) { if( rcond( m ) >= tol || n == 1 ) { 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" ) } return( min( ev ) > -tol ) } else { for( i in 1:n ) { mm <- m[ -i, -i, 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/nParam.R0000644000175100001440000000033011400734514014001 0ustar hornikusers## 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/ddnorm.R0000644000175100001440000000034111403431243014044 0ustar hornikusers## 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/nObs.R0000644000175100001440000000035511400730177013474 0ustar hornikusers## 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/compPlot.R0000644000175100001440000000220712066361274014375 0ustar hornikuserscompPlot <- 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/coefTable.R0000644000175100001440000000067411315172500014456 0ustar hornikuserscoefTable <- 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/checkNames.R0000644000175100001440000000036511315172500014630 0ustar hornikuserscheckNames <- function( testNames, allNames ) { inAllNames <- testNames %in% allNames if( !all( inAllNames ) ) { stop( "object(s) '", paste( testNames[ !inAllNames ], collapse = "', '" ), "' not found." ) } } miscTools/R/margEff.R0000644000175100001440000000027411642320342014137 0ustar hornikusersmargEff <- function( object, ... ) UseMethod( "margEff" ) # default method margEff.default <- function( object, ... ) { stop( "there is currently no default method available" ) } miscTools/R/stdEr.R0000644000175100001440000000107211437705522013657 0ustar hornikusers### 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/logDataSet.R0000755000175100001440000000137411317565067014642 0ustar hornikuserslogDataSet <- function( data, varNames, varNamesNum = NULL ) { if( "plm.dim" %in% class( data ) ) { logData <- data[ , 1:2 ] } else { logData <- data.frame( no = c( 1:nrow( data ) ) ) } for( i in seq( along = varNames ) ) { logData[[ varNames[ i ] ]] <- log( data[[ varNames[ i ] ]] ) } for( i in seq( along = varNamesNum ) ) { if( is.factor( data[[ varNamesNum[ i ] ]] ) | is.logical( data[[ varNamesNum[ i ] ]] ) ) { logData[[ varNamesNum[ i ] ]] <- data[[ varNamesNum[ i ] ]] } else { logData[[ varNamesNum[ i ] ]] <- log( data[[ varNamesNum[ i ] ]] ) } } if( ! "no" %in% c( varNames, varNamesNum ) ) { logData$no <- NULL } return( logData ) } miscTools/R/sumKeepAttr.R0000644000175100001440000000043611414402624015035 0ustar hornikusers## 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/colMedians.R0000644000175100001440000000166111344460160014651 0ustar hornikuserscolMedians <- 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/MD50000644000175100001440000000526113016034471012557 0ustar hornikusers6ed1597eb03dc6fac7e10c15b195240d *DESCRIPTION b1fb1c198bfbd44fccdf835b93cdb7a0 *NAMESPACE 3218f44259d14dddd8d39dc969836785 *NEWS e3babd76fec6b1c5ab4604f68d45ef1c *R/checkNames.R 252d30d0a896bd1b9f0bf942c72181b5 *R/coefTable.R d50ca2328c07306b8f5c35e22911ffc7 *R/colMedians.R 2aeaa005d2bb31a30b3388430127ebb9 *R/compPlot.R fbc8147e79f22b1e16543a8b02df41d6 *R/ddnorm.R c5f0c9986689896bbb089720ff5d12a1 *R/logDataSet.R 5c6bf1348fbafd09c133c6837bda7d7f *R/margEff.R 486e412f9aed7a22cf4af6a2fb0d8efb *R/nObs.R 959fd81d0615a9e57c21035e51368c80 *R/nParam.R 416cfea872584e41aae714b507b0b33a *R/semidef.R 0ffc45f50a2545ebd525b6d23e66ec56 *R/stdEr.R b3885cebbf5692eb72ec9c281abe08ae *R/sumKeepAttr.R beaed4a5fa7d5a6a78edf8a0313c273f *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 6ac70669df2074e1456fb4d72ae612a6 *man/miscTools-internal.Rd 1b3046f8fb6b9e044ead795e782eed75 *man/nObs.Rd c01313e697ec6d374c55ba69cc1c4ef5 *man/nParam.Rd fe933136168a3f27476ca13f64b86413 *man/quasiconcavity.Rd 02f6f6e809b64e9c1415765ad83d95b0 *man/rSquared.Rd f786c67daf28b8336a4a73c791f20817 *man/rowMedians.Rd 39cbd1282fd0e82222c129d3ed157016 *man/semidefiniteness.Rd c593269b216697ea39ef815876c5f2d9 *man/stdEr.Rd 9ad446f2d2b4b0230823b556445838f2 *man/sumKeepAttr.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 ef7f6aa53cc92f2159389c2721cbd399 *tests/stdErTests.R 369cac7937ee7257465691b89ffedbbe *tests/stdErTests.Rout.save 3383c0c8b0b4191bddfb7f1d4f59e9e1 *tests/sumKeepAttrTest.R 757f1c6e3472103b69dcba9d6e5c50b2 *tests/sumKeepAttrTest.Rout.save miscTools/DESCRIPTION0000644000175100001440000000142713016034471013755 0ustar hornikusersPackage: miscTools Version: 0.6-22 Date: 2016-11-25 Title: Miscellaneous Tools and Utilities Author: Arne Henningsen, Ott Toomet Maintainer: Arne Henningsen Depends: R (>= 2.14.0) 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: 2016-11-25 07:44:12 UTC; arne Repository: CRAN Date/Publication: 2016-11-25 14:14:33 miscTools/man/0000755000175100001440000000000013015765714013030 5ustar hornikusersmiscTools/man/semidefiniteness.Rd0000644000175100001440000001246013015530256016647 0ustar hornikusers\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}. Due to rounding errors, which are unavoidable on digital computers, those eigenvalues of a singular matrix that 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 eigenvalues of an \eqn{N \times N}{NxN} matrix with reciprocal condition number smaller than argument \code{tol} but checks whether all \eqn{N} \eqn{(N-1) \times (N-1)}{(N-1)x(N-1)} submatrices with row \eqn{i} and column \eqn{i}, \eqn{i = 1, ..., N}, removed are positive semidefinite. 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/margEff.Rd0000644000175100001440000000075511642321247014666 0ustar hornikusers\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/man/insertRow.Rd0000644000175100001440000000114011315172501015272 0ustar hornikusers\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/veclipos.Rd0000755000175100001440000000146211315172501015134 0ustar hornikusers\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/insertCol.Rd0000644000175100001440000000116411315172501015246 0ustar hornikusers\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.Rd0000644000175100001440000000156212066621770015116 0ustar hornikusers\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/miscTools-internal.Rd0000644000175100001440000000050511317565124017101 0ustar hornikusers\name{miscTools-internal} \alias{checkNames} \alias{logDataSet} % 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/rowMedians.Rd0000644000175100001440000000115511344460104015415 0ustar hornikusers\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/stdEr.Rd0000644000175100001440000000151211437676477014414 0ustar hornikusers\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/sumKeepAttr.Rd0000644000175100001440000000151511414403154015551 0ustar hornikusers\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/ddnorm.Rd0000644000175100001440000000152411403434732014574 0ustar hornikusers\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/vecli2m.Rd0000644000175100001440000000075211315172501014647 0ustar hornikusers\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/rSquared.Rd0000644000175100001440000000103411315734373015101 0ustar hornikusers\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/quasiconcavity.Rd0000644000175100001440000000214611315172501016347 0ustar hornikusers\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/triang.Rd0000755000175100001440000000100411315172501014564 0ustar hornikusers\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/colMedians.Rd0000644000175100001440000000170711344461541015374 0ustar hornikusers\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/vecli.Rd0000755000175100001440000000073211315172501014411 0ustar hornikusers\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/nObs.Rd0000644000175100001440000000177211642321257014221 0ustar hornikusers\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/symMatrix.Rd0000644000175100001440000000177611315172501015312 0ustar hornikusers\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/coefTable.Rd0000644000175100001440000000134411315172501015170 0ustar hornikusers\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/nParam.Rd0000644000175100001440000000222511400733751014526 0ustar hornikusers\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}