gmodels/0000755000176000001440000000000012217322402011727 5ustar ripleyusersgmodels/inst/0000755000176000001440000000000011772725076012727 5ustar ripleyusersgmodels/inst/NEWS0000644000176000001440000000461211772724527013431 0ustar ripleyusersVersion 2.15.3 - 2012-06-27 --------------------------- Bug fixes: - Update est.mer() to work with "mer" object changes introduced in lme4 version 0.999999-0. Version 2.15.2 - 2012-04-19 --------------------------- Bug fixes: - Update est.mer() to work with recent versions of lme4 which changed 'mer' objects from S3 to S4 class - Changes to pass new R CMD check tests - The 'Design' package has been replaced my 'rms', so update man page references. Version 2.15.1 - 2011-01-16 --------------------------- Bug fixes: - Fix warnings reported by new versions of R CMD check. Version 2.15.0 -------------- New features: - Add support for 'mer' model from lme4. Bug fixes: - Correct several minor .Rd syntax errors - Move extra copyright text to Author field instead of License field. Version 2.14.1 -------------- New features: - Add support for 'lme' objects to estimable(). Other: - Fix minor typos in manual page for estimable(). Version 2.14.0 -------------- New Features: - Add support for 'mlm' objects to estimable Version 2.13.2 -------------- Bug Fixes: - Lower and upper end of confidence interval for lmer objects were reversed in est.lmer(). - Correct Greg's email address in two help files. Version 2.13.1 -------------- Bug Fixes: - Problem: R CMD check errors under development version of R 2.5.0 Solution: - Add additional packages to 'Suggests' list in DESCRIPTION - Remove extra trailing comma in function calls - fix various code/doc inconsistencies - Problem: estimable() was failing for lmer objects. Solution: - Create a generic estimable() - Move old function to estimable.default() - Add estimable.lmer() to the exported methods list in NAMESPACE Version 2.13.0 -------------- Version 2.12.0 -------------- - Updated Greg's email address. - Add support for lmer (lme version 4) objects to ci(), estimable(), and fit.contrast() via code contributed by Randall C Johnson. - Add simplfied coefficient specification to estimable() based on a function provided by Randall C Johnson. It is now possible to do things like: estimable(reg, c("xB"=1,"xD"=-1)) instead of: estimable(reg, c( 0, 1, 0, -1)) which should make estimable() much easier to use for large models. Version 2.1.0 ------------- Version 2.0.8 ------------- - Added DESCRIPTION and removed DESCRIPTION.in - Updated CrossTable.R - Updated NAMESPACE file gmodels/inst/ChangeLog0000644000176000001440000004675211772724233014511 0ustar ripleyusers2012-06-28 00:41 warnes * [r1575] R/est.lmer.R, R/est.mer.R: Update est.mer() to support new S4 "mer" class. 2012-06-28 00:40 warnes * [r1574] man/ci.Rd: Make lme4 example executable. 2012-06-27 22:42 warnes * [r1573] test/lme-test.R: Add test code submitted by Ariel.Muldoon@oregonstate.edu. 2012-04-19 22:09 warnes * [r1528] inst/NEWS: Update for release 2.15.2 2012-04-19 22:07 warnes * [r1527] DESCRIPTION: Update version and date. 2012-04-19 22:06 warnes * [r1526] man/estimable.Rd: The 'Design' package has been replaced my 'rms', so update man page references. 2012-04-19 22:05 warnes * [r1525] R/ci.R, R/est.mer.R: More fixes for support of S4 'mer' class from lme4 package. 2012-04-19 21:13 warnes * [r1524] man/coefFrame.Rd: Split long line. 2012-04-19 17:50 warnes * [r1523] man/ci.Rd, man/glh.test.Rd: Changes to pass R CMD check 2011-12-14 18:17 warnes * [r1521] R/ci.R: Improve formatting of ci.mer(). 2011-12-14 18:14 warnes * [r1520] R/est.mer.R: Modify est.mer to work with recent lme4 'mer' S4 objects. 2011-01-16 22:17 warnes * [r1466] DESCRIPTION, inst/NEWS, man/ci.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Fix warnings reported by R CMD check. Update version number to 2.15.1. 2009-05-09 05:29 warnes * [r1337] test, test/lme-test.R: Add tests for lme4 'mer' objects 2009-05-09 05:04 warnes * [r1336] inst/NEWS: Update for 2.15.0 2009-05-09 05:02 warnes * [r1335] DESCRIPTION: Update description for 2.15.0 2009-05-09 05:01 warnes * [r1334] R/est.mer.R: Add support for lme4's 'mer' objects 2009-05-09 05:00 warnes * [r1333] NAMESPACE, R/ci.R, R/est.lmer.R, R/estimable.R, R/fit.contrast.R, R/to.est.R: Add support for lme4's 'mer' objects 2009-05-09 04:53 warnes * [r1332] man/glh.test.Rd: Fix .Rd syntax error 2009-05-09 04:37 warnes * [r1331] NEWS: Add softlinks for ChangeLog and NEWS to top level dir for convenience 2009-05-09 04:36 warnes * [r1330] ChangeLog, NEWS, inst, inst/NEWS: Move ChangeLog and NEWS files into inst directory 2009-05-09 04:00 warnes * [r1329] DESCRIPTION, man/ci.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Update Greg's email address 2008-04-10 14:05 warnes * [r1255] man/ci.Rd: Improve languages a bit 2008-01-02 16:56 warnes * [r1236] man/CrossTable.Rd: Update Marc's email address 2007-12-12 21:16 warnes * [r1233] DESCRIPTION: Move copyright notice for Randall's contributions from License section to Author section of the DESCRIPTION file. 2007-12-07 22:21 warnes * [r1232] DESCRIPTION, NEWS: Update DESCRIPTION and NEWS for release 2.14.1 2007-12-07 22:10 warnes * [r1231] man/estimable.Rd: Correct minor typos in man page for estimable() 2007-12-07 22:09 warnes * [r1230] R/estimable.R: Add support for lme models to estimable() 2007-12-07 22:07 warnes * [r1229] man/estimable.Rd: Replace non-ascii characters in Soren's name with (equivalent?) ascii character to avoid character encoding issues. 2007-10-22 02:24 warnes * [r1196] DESCRIPTION: Clarify GPL version 2007-07-26 00:20 warnes * [r1105] DESCRIPTION, NAMESPACE, NEWS, R/estimable.mlm.R, man/estimable.Rd: Add support for mlm to estimable(). 2007-07-26 00:10 warnes * [r1104] R/estimable.R, R/estimable.mlm.R: Add estimable method for mlm objects 2007-03-09 22:35 warnes * [r1079] R/ci.R: Remove stray character 2007-03-09 20:10 warnes * [r1078] NEWS: Update NEWS file. 2007-03-09 20:07 warnes * [r1077] DESCRIPTION: Update version number 2007-03-09 20:06 warnes * [r1076] R/ci.R: Minor code formatting changes 2007-03-09 20:06 warnes * [r1075] R/est.lmer.R, man/ci.Rd: Flip lower and upper interval in ci.lmer(). Add example to man page. 2007-03-09 19:43 warnes * [r1074] man/ci.Rd, man/estimable.Rd: Fix some old email addressses that got missed 2006-11-29 00:11 warnes * [r1029] NEWS: Update for 2.13.1 2006-11-29 00:05 warnes * [r1028] NAMESPACE: Correct declartion of S3 methods for estimable() 2006-11-29 00:05 warnes * [r1027] DESCRIPTION: Add additional suggested packages 2006-11-29 00:04 warnes * [r1026] R/estimable.R, man/estimable.Rd: - Add generic - Fix code vs. doc inconsistiencies 2006-11-28 22:38 warnes * [r1025] R/ci.R, R/estimable.R, R/fast.prcomp.R: Remove extraneous comma that causes errors in R 2.5.0 2006-11-27 20:45 warnes * [r1016] DESCRIPTION, NEWS: Update for 2.13.1 2006-11-27 20:36 warnes * [r1015] DESCRIPTION, NAMESPACE: Add missing export of methods for estimable() 2006-11-14 22:25 ggorjan * [r1012] R/ci.R, R/fast.prcomp.R, man/ci.Rd: Removed executable property 2006-08-02 22:21 warnes * [r977] man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Update my email address 2006-06-06 19:17 nj7w * [r966] man/ci.Rd, man/estimable.Rd, man/fit.contrast.Rd: Updated ci, estimable and fit.contrast as per Randall Johnson 2006-06-05 21:00 nj7w * [r965] DESCRIPTION: Additions as per Randall C Johnson 2006-06-05 20:59 nj7w * [r964] R/ci.R, R/estimable.R, R/fit.contrast.R, R/to.est.R: Additions as per Randall C Johnson 2006-06-05 20:57 nj7w * [r963] R/est.lmer.R: - New function to estimate CI's and p-values using mcmcsamp() from the Matrix package 2006-05-05 18:29 nj7w * [r959] R/CrossTable.R, man/CrossTable.Rd: Fixed an error: According to Marc Schwartz - there was an error when a matrix without dimnames(or names(dimnames)) was passed as x argument 2005-12-13 16:03 nj7w * [r808] ChangeLog: Removed ChangeLog 2005-12-13 16:02 nj7w * [r807] NEWS: Updated NEWS 2005-12-12 21:57 nj7w * [r796] DESCRIPTION: Updated version number for CRAN 2005-12-04 06:27 warnes * [r781] NEWS: Update for 2.11.0 2005-12-04 06:12 warnes * [r780] DESCRIPTION, NAMESPACE, R/ci.R, R/estimable.R, R/fit.contrast.R, R/to.est.R, man/ci.Rd, man/estimable.Rd: Integration of code changes suggested by Randall C Johnson to add support for lmer (lme version 4) objects to ci(), estimable(), and fit.contrast(). Addition of simplified coefficient specificaiton for estimable() based on a function provided by Randall C Johnson. It is now possible to do things like: estimable(reg, c("xB"=1,"xD"=-1) ) instead of: estimable(reg, c( 0, 1, 0, -1) ) which should make estimable much easier to use for large models. 2005-12-01 16:54 nj7w * [r776] man/ci.Rd, man/coefFrame.Rd, man/estimable.Rd, man/fit.contrast.Rd, man/make.contrasts.Rd: Updated Greg's email address 2005-10-27 11:21 warnes * [r709] DESCRIPTION: Update version number. Bump minor version since we added functionality. 2005-10-27 10:33 warnes * [r708] DESCRIPTION, NAMESPACE: Add ci.binom() to NAMESPACE, bump version 2005-10-26 13:39 warnes * [r707] R/ci.R, man/ci.Rd: Add ci.binom 2005-10-25 21:18 warnes * [r706] NAMESPACE: Add gdata::nobs to import list. Needed by ci() 2005-09-12 15:44 nj7w * [r671] man/fast.prcomp.Rd, man/glh.test.Rd: Updated Greg's email 2005-09-07 15:31 nj7w * [r667] man/CrossTable.Rd: Fixed man page 2005-09-06 21:34 nj7w * [r664] DESCRIPTION: Updated DESCRIPTION 2005-09-06 21:34 nj7w * [r663] NEWS: Added NEWS 2005-09-06 16:21 nj7w * [r662] DESCRIPTION: Fixed the Package name 2005-09-02 23:10 nj7w * [r655] ChangeLog: Added ChangeLog 2005-08-31 16:28 nj7w * [r644] DESCRIPTION: Added DESCRIPTION file 2005-08-31 16:27 nj7w * [r643] DESCRIPTION.in: removed DESCRIPTION.in 2005-07-11 21:35 nj7w * [r627] R/CrossTable.R, man/CrossTable.Rd: Revision based on Marc Schwartz's suggestions: 1) Added 'dnn' argument to enable specification of dimnames as per table() 2) Corrected bug in SPSS output for 1d table, where proportions were being printed and not percentages ('%' output) 2005-06-09 14:20 nj7w * [r625] R/ci.R, R/coefFrame.R, R/estimable.R, R/fast.prcomp.R, R/fit.contrast.R, R/glh.test.R, R/make.contrasts.R, man/CrossTable.Rd, man/ci.Rd, man/coefFrame.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Updating the version number, and various help files to synchronize splitting of gregmisc bundle in 4 individual components. 2005-06-09 14:13 nj7w * [r623] R/CrossTable.R: Updates by Marc Schwartz: CrossTable: # Revision 2.0 2005/04/27 # Added 'format = "d"' to all table count output # so that large integers do not print in # scientific notation 2005-05-13 18:59 nj7w * [r621] man/CrossTable.Rd: 1) Using dQuote.ascii function in read.xls as the new version of dQuote doesn't work proprly with UTF-8 locale. 2) Modified CrossTable.Rd usage in gmodels 3) Modified heatmap.2 usage in gplots. 2005-05-11 13:51 warnes * [r620] DESCRIPTION.in, NAMESPACE: Add dependency on gdata::frameApply. 2005-03-31 20:32 warnes * [r593] NAMESPACE: Add ceofFrame function to NAMESPACE 2005-03-31 19:05 warnes * [r592] man/coefFrame.Rd: coefFrame example needs to properly load ELISA data from gtools package 2005-03-31 18:31 warnes * [r588] R/CrossTable.R, man/CrossTable.Rd, man/ci.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Ensure that each file has $Id$ header, and no $Log$ 2005-03-31 18:30 warnes * [r587] R/coefFrame.R, man/coefFrame.Rd: Add coefFrame() function contributed by Jim Rogers 2005-01-18 19:53 warnes * [r521] R/CrossTable.R: Removed Windows Line Endings 2005-01-14 21:40 nj7w * [r518] man/CrossTable.Rd: Updated the manual to reflect prop.chisq change in its R file. 2005-01-14 19:14 warnes * [r517] R/CrossTable.R: Nitin added display of the Chisquare contribution of each cell, as suggested by Greg Snow. 2005-01-12 20:50 warnes * [r515] DESCRIPTION.in: Add dependency on R 1.9.0+ to prevent poeple from installing on old versions of R which don't support namespaces. 2004-12-23 19:32 nj7w * [r507] R/CrossTable.R, man/CrossTable.Rd: Split the function print.CrossTable.vector in two parts - for SAS behaiour and SPSS behaviour. Also put the code of printing statistics in a function 'print.statistics' 2004-12-21 22:38 warnes * [r502] R/CrossTable.R: Added & extended changes made by Nitin to implement 'SPSS' format, as suggested by Dirk Enzmann . 2004-09-30 21:03 warneg * [r464] man/glh.test.Rd: Fix typos. 2004-09-27 21:01 warneg * [r461] DESCRIPTION, DESCRIPTION.in: Updated to pass R CMD check. 2004-09-03 22:44 warneg * [r450] man/fit.contrast.Rd: Add explicit package to call to quantcut in example. 2004-09-03 17:27 warneg * [r446] DESCRIPTION, NAMESPACE, R/CrossTable.R, R/ci.R, R/estimable.R, R/fast.prcomp.R, R/fit.contrast.R, R/glh.test.R, R/make.contrasts.R, man/estimable.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: initial bundle checkin 2004-09-02 17:14 warneg * [r442] DESCRIPTION, DESCRIPTION.in, NAMESPACE: Initial revision 2004-05-25 02:57 warnes * [r327] R/CrossTable.R, man/CrossTable.Rd: Updates from Mark Schwartz. 2004-04-13 11:41 warnes * [r314] man/estimable.Rd: Fix latex warning: it doesn't like double subscripts. 2004-03-26 22:28 warnes * [r306] man/fast.prcomp.Rd: Reflect movement of code from 'mva' package to 'stats' in R 1.9.0. 2004-03-25 20:09 warnes * [r296] R/estimable.R, man/estimable.Rd: - Estimable was reporting sqrt(X^2) rather than X^2 in the output. - Provide latex math markup for linear algebra expressions in help text. - Other clarifications in help text 2004-03-25 18:17 warnes * [r295] R/estimable.R, man/estimable.Rd: Add enhancements to estimable() provided by S�ren H�jsgaard \email{sorenh@agrsci.dk}: I have made a modified version of the function [..] which 1) also works on geese and gee objects and 2) can test hypotheses af the forb L * beta = beta0 both as a single Wald test and row-wise for each row in L. 2003-11-17 21:40 warnes * [r221] R/fit.contrast.R: - Fix incorrect handling of glm objects by fit.contrast, as reported by Ulrich Halekoh, Phd . - Add regression test code to for this bug. 2003-08-07 03:49 warnes * [r217] R/ci.R: - Fixed incorrect denominator in standard error for mean in ci.default. 2003-04-22 17:24 warnes * [r190] R/fit.contrast.R: - the variable 'df' was used within the lme code section overwriting the argument 'df'. 2003-03-12 17:58 warnes * [r173] man/fit.contrast.Rd: - Fixed a typo in the example - Added to lme example 2003-03-07 15:48 warnes * [r168] R/fast.prcomp.R: - Minor changes to code to allow the package to be provided as an S-Plus chapter. 2003-01-30 21:53 warnes * [r160] R/fit.contrast.R, man/fit.contrast.Rd: - Renamed 'contrast.lm' to 'fit.contrast'. This new name is more descriptive and makes it easier to create and use methods for other classes, eg lme. - Enabled fit.contrast for lme object now that Doug Bates has provided the necessary support for contrasts in the nlme package. - New contrast.lm function which generates a 'depreciated' warning and calls fit.contrast - Updated help text to match changes. 2003-01-30 21:41 warnes * [r158] R/CrossTable.R, man/CrossTable.Rd: - Removed argument 'correct' and now print separate corrected values for 2 x 2 tables. - Added arguments 'prop.r', 'prop.c' and 'prop.t' to toggle printing of row, col and table percentages. Default is TRUE. - Added argument 'fisher' to toggle fisher exact test. Default is FALSE. - Added McNemar test to statistics and argument 'mcnemar' to toggle test. Default is FALSE. - Added code to generate an invisible return list containing table counts, proportions and the results of the appropriate statistical tests. 2003-01-30 14:58 warnes * [r157] R/make.contrasts.R: - Added explicit check to ensure that the number of specified contrasts is less than or equal to the ncol - 1. Previously, this failed with an obtuse error message when the contrast matrix had row names, and silently dropped contrasts over ncol-1. 2002-11-04 14:13 warnes * [r142] R/CrossTable.R: - Moved fisher.test() to after table is printed, so that table is still printed in the event that fisher.test() results in errors. 2002-10-29 23:06 warnes * [r138] R/fast.prcomp.R, man/fast.prcomp.Rd: - Fixes to fast.svd to make it actually work. - Updates to man page to fix mistmatches between code and docs and to fix warnings. 2002-10-29 23:00 warnes * [r137] R/make.contrasts.R, man/make.contrasts.Rd: - Moved make.contrasts to a separate file. - Enhanced make contrasts to better label contrast matrix, to give how.many a default value, and to coerce vectors into row matrixes. - Added help page for make.contrasts. - Added link from contrasts.lm seealso to make.contrasts. 2002-10-29 19:29 warnes * [r136] R/fast.prcomp.R, man/fast.prcomp.Rd: Initial checkin for fast.prcomp() and fast.svd(). 2002-09-26 12:11 warnes * [r127] man/glh.test.Rd: - Added note and example code to illustrate how to properly compute contrasts for the first factor in the model. 2002-09-24 19:12 warnes * [r124] R/glh.test.R: - Fixed a typo. 2002-09-23 14:27 warnes * [r119] man/CrossTable.Rd, man/glh.test.Rd: - Fixed syntax errors in barplot2.Rd and CrossTable.Rd - Fixed incorrect translation of 'F' (distribution) to 'FALSE' in glh.test.Rd 2002-09-23 13:59 warnes * [r117] R/ci.R, man/estimable.Rd, man/glh.test.Rd: - Modified all files to include CVS Id and Log tags. 2002-09-23 13:38 warnes * [r116] R/CrossTable.R, man/CrossTable.Rd: - Added CrossTable() and barplot2() code and docs contributed by Marc Schwartz. - Permit combinations() to be used when r>n provided repeat.allowed=TRUE - Bumped up version number 2002-08-01 19:37 warnes * [r114] R/ci.R, man/ci.Rd, man/estimable.Rd, man/glh.test.Rd: - Corrected documentation mismatch for ci, ci.default. - Replaced all occurences of '_' for assignment with '<-'. - Replaced all occurences of 'T' or 'F' for 'TRUE' and 'FALSE' with the spelled out version. - Updaded version number and date. 2002-04-09 00:51 warneg * [r109] R/ci.R, R/estimable.R, R/glh.test.R, man/glh.test.Rd: Checkin for version 0.5.3 2002-03-26 21:22 warneg * [r104] R/ci.R, R/glh.test.R, man/ci.Rd, man/glh.test.Rd: - Changed methods to include '...' to match the generic. - Updated for version 0.5.1 2002-03-26 15:30 warneg * [r99] man/glh.test.Rd: Removed incorrect link to 'contrast' from seealso. 2002-02-20 20:09 warneg * [r81] man/ci.Rd, man/estimable.Rd, man/glh.test.Rd: Minor changes, typo and formatting fixes. 2002-01-17 23:51 warneg * [r70] man/estimable.Rd: - Fixed errror in last example by adding 'conf.int' parameter to 'estimable' call. 2002-01-17 23:42 warneg * [r69] R/glh.test.R: - Fixed typo in code that resulted in an syntax error. 2002-01-10 17:35 warneg * [r68] R/glh.test.R: - print.glh.test() was using cat() to printing the call. This didn't work and generated an error. 2001-12-19 20:06 warneg * [r66] man/glh.test.Rd: - Fixed display of formulae. - Added description of return value 2001-12-19 20:05 warneg * [r65] R/glh.test.R: - Removed extra element of return object. 2001-12-18 22:14 warneg * [r64] man/estimable.Rd: - Updated documentation to reflect change of parameters from 'alpha' to 'conf.int', including the new optional status of the confidence intervals. 2001-12-18 22:12 warneg * [r63] R/estimable.R: - Modified to make confidence intervals optional. Changed 'alpha' parameter giving significance level to 'conf.int' giving confidence level. 2001-12-18 21:36 warneg * [r62] man/glh.test.Rd: - Added summary.glh.test to alias, usage, and example sections. 2001-12-18 21:34 warneg * [r61] R/glh.test.R: - Modified to work correctly when obj is of class 'aov' by specifying summary.lm instead of summary. This ensures that the summary object has the fields we need. - Moved detailed reporting of results from 'print' to 'summary' function and added a simpler report to 'print' 2001-12-18 21:27 warneg * [r60] R/estimable.R: - Modified to work correctly when obj is of class 'aov' by specifying summary.lm instead of summary. This ensures that the summary object has the fields we need. 2001-12-18 00:45 warneg * [r59] R/glh.test.R, man/glh.test.Rd: Initial checkin. 2001-12-17 18:59 warneg * [r56] man/estimable.Rd: - Fixed spelling errors. 2001-12-17 18:52 warneg * [r55] man/estimable.Rd: - Fixed the link to contrasts.lm. - Rephrased title/description to be more clear. 2001-12-10 19:35 warneg * [r49] man/estimable.Rd: Renamed 'contrsts.coeff.Rd' to 'estimable.Rd' corresponding to function rename. 2001-12-10 19:26 warneg * [r48] R/estimable.R: renamed from contrast.coeff.R to estimable.R (incorrectly via contrast.lm.R) 2001-12-07 19:50 warneg * [r37] man/ci.Rd: - Added text noting that lme is now supported. 2001-12-07 19:19 warneg * [r36] R/ci.R: - Fixed typo: DF column was being filled in with p-value. 2001-12-07 18:49 warneg * [r35] R/ci.R: - Added ci.lme method to handle lme objects. 2001-10-16 23:15 warneg * [r27] man/ci.Rd: Fixed unbalanced brace. 2001-08-25 05:52 warneg * [r12] man/ci.Rd: - Added CVS header. - Added my email address. 2001-05-30 13:23 warneg * [r2] ., R, R/ci.R, man, man/ci.Rd: Initial revision gmodels/NAMESPACE0000644000176000001440000000117011772724120013155 0ustar ripleyusers export( CrossTable, ci, ci.binom, coefFrame, estimable, fast.prcomp, fast.svd, fit.contrast, glh.test, make.contrasts, print.glh.test, summary.glh.test ) S3method(ci, default) S3method(ci, binom) S3method(ci, lm) S3method(ci, lme) S3method(ci, mer) S3method(fit.contrast, lm) S3method(fit.contrast, lme) S3method(fit.contrast, mer) S3method(estimable, default) S3method(estimable, mer) S3method(estimable, mlm) S3method(print, glh.test) S3method(summary, glh.test) importFrom(MASS, ginv) importFrom(gdata, frameApply) importFrom(gdata, nobs) gmodels/NEWS0000644000176000001440000000461211772724527012454 0ustar ripleyusersVersion 2.15.3 - 2012-06-27 --------------------------- Bug fixes: - Update est.mer() to work with "mer" object changes introduced in lme4 version 0.999999-0. Version 2.15.2 - 2012-04-19 --------------------------- Bug fixes: - Update est.mer() to work with recent versions of lme4 which changed 'mer' objects from S3 to S4 class - Changes to pass new R CMD check tests - The 'Design' package has been replaced my 'rms', so update man page references. Version 2.15.1 - 2011-01-16 --------------------------- Bug fixes: - Fix warnings reported by new versions of R CMD check. Version 2.15.0 -------------- New features: - Add support for 'mer' model from lme4. Bug fixes: - Correct several minor .Rd syntax errors - Move extra copyright text to Author field instead of License field. Version 2.14.1 -------------- New features: - Add support for 'lme' objects to estimable(). Other: - Fix minor typos in manual page for estimable(). Version 2.14.0 -------------- New Features: - Add support for 'mlm' objects to estimable Version 2.13.2 -------------- Bug Fixes: - Lower and upper end of confidence interval for lmer objects were reversed in est.lmer(). - Correct Greg's email address in two help files. Version 2.13.1 -------------- Bug Fixes: - Problem: R CMD check errors under development version of R 2.5.0 Solution: - Add additional packages to 'Suggests' list in DESCRIPTION - Remove extra trailing comma in function calls - fix various code/doc inconsistencies - Problem: estimable() was failing for lmer objects. Solution: - Create a generic estimable() - Move old function to estimable.default() - Add estimable.lmer() to the exported methods list in NAMESPACE Version 2.13.0 -------------- Version 2.12.0 -------------- - Updated Greg's email address. - Add support for lmer (lme version 4) objects to ci(), estimable(), and fit.contrast() via code contributed by Randall C Johnson. - Add simplfied coefficient specification to estimable() based on a function provided by Randall C Johnson. It is now possible to do things like: estimable(reg, c("xB"=1,"xD"=-1)) instead of: estimable(reg, c( 0, 1, 0, -1)) which should make estimable() much easier to use for large models. Version 2.1.0 ------------- Version 2.0.8 ------------- - Added DESCRIPTION and removed DESCRIPTION.in - Updated CrossTable.R - Updated NAMESPACE file gmodels/R/0000755000176000001440000000000012217321655012141 5ustar ripleyusersgmodels/R/CrossTable.R0000644000176000001440000005406610451013036014325 0ustar ripleyusers# Revision 2.2 2006/05/02 # Fix a bug when a matrix is passed as the 'x' argument # Reported by Prof. Albert Sorribas same day # Fix involved creating default values for RowData and ColData # when there are no dimnames for the matrix # Revision 2.1 2005/06/26 # Added 'dnn' argument to enable specification of dimnames # as per table() # Correct bug in SPSS output for 1d table, where proportions # were being printed and not percentages ('%' output) # Revision 2.0 2005/04/27 # Added 'format = "d"' to all table count output # so that large integers do not print in # scientific notation CrossTable <- function (x, y, digits = 3, max.width = 5, expected = FALSE, prop.r = TRUE, prop.c = TRUE, prop.t = TRUE, prop.chisq = TRUE, chisq = FALSE, fisher = FALSE, mcnemar = FALSE, resid = FALSE, sresid = FALSE, asresid = FALSE, missing.include = FALSE, format = c("SAS", "SPSS"), dnn = NULL, ... ) { format = match.arg(format) RowData <- deparse(substitute(x)) if (!missing(y)) ColData <- deparse(substitute(y)) ## Ensure that max.width >= 1 if (max.width < 1) stop("max.width must be >= 1") ## Set 'x' vector flag vector.x <- FALSE ## Ensure that if (expected), a chisq is done if (expected) chisq <- TRUE if (missing(y)) { ## is x a vector? if (is.null(dim(x))) { if (missing.include) x <- factor(x,exclude=NULL) else ## Remove any unused factor levels x <- factor(x) t <- t(as.matrix(table(x))) vector.x <- TRUE } ## is x a matrix? else if (length(dim(x) == 2)) { if(any(x < 0) || any(is.na(x))) stop("all entries of x must be nonnegative and finite") ## Check to see if x has names(dimnames) defined. If yes, use these for ## 'RowData' and 'ColData' labels, else create blank ones ## This can be overridden by setting 'dnn' values if (is.null(names(dimnames(x)))) { RowData <- "" ColData <- "" } else { RowData <- names(dimnames(x))[1] ColData <- names(dimnames(x))[2] } ## Add generic column and rownames if required ## check each separately, in case user has defined one or the other if (is.null(rownames(x))) rownames(x) <- paste("[", 1:nrow(x), ",]", sep = "") if (is.null(colnames(x))) colnames(x) <- paste("[,", 1:ncol(x), "]", sep = "") t <- x } else stop("x must be either a vector or a 2 dimensional matrix, if y is not given") } else { if(length(x) != length(y)) stop("x and y must have the same length") if (missing.include) { x <- factor(x, exclude=c()) y <- factor(y, exclude=c()) } else { ## Remove unused factor levels from vectors x <- factor(x) y <- factor(y) } ## Generate table t <- table(x, y) } ## Create Titles for Table From Vector Names ## At least 2 x 2 table only (for now) if (all(dim(t) >= 2)) { if (!is.null(dnn)) { if (length(dnn) != 2) stop("dnn must have length of 2, one element for each table dimension") else { RowData <- dnn[1] ColData <- dnn[2] } } } ## if t is not at least a 2 x 2, do not do stats ## even if any set to TRUE. Do not do col/table props if (any(dim(t) < 2)) { prop.c <- prop.r <- prop.chisq <- chisq <- expected <- fisher <- mcnemar <- FALSE } ## Generate cell proportion of row CPR <- prop.table(t, 1) ## Generate cell proportion of col CPC <- prop.table(t, 2) ## Generate cell proportion of total CPT <- prop.table(t) ## Generate summary counts GT <- sum(t) RS <- rowSums(t) CS <- colSums(t) if (length(dim(x) == 2)) TotalN <- GT else TotalN <- length(x) ## Column and Row Total Headings ColTotal <- "Column Total" RowTotal <- "Row Total" ## Set consistent column widths based upon dimnames and table values CWidth <- max(digits + 2, c(nchar(t), nchar(dimnames(t)[[2]]), nchar(RS), nchar(CS), nchar(RowTotal))) RWidth <- max(c(nchar(dimnames(t)[[1]]), nchar(ColTotal))) ## Adjust first column width if Data Titles present if (exists("RowData")) RWidth <- max(RWidth, nchar(RowData)) ## Create row separators RowSep <- paste(rep("-", CWidth + 2), collapse = "") RowSep1 <- paste(rep("-", RWidth + 1), collapse = "") SpaceSep1 <- paste(rep(" ", RWidth), collapse = "") SpaceSep2 <- paste(rep(" ", CWidth), collapse = "") ## Create formatted Names FirstCol <- formatC(dimnames(t)[[1]], width = RWidth, format = "s") ColTotal <- formatC(ColTotal, width = RWidth, format = "s") RowTotal <- formatC(RowTotal, width = CWidth, format = "s") ## Perform Chi-Square Tests ## Needs to be before the table output, in case (expected = TRUE) if (chisq) { if (all(dim(t) == 2)) CSTc <- chisq.test(t, correct = TRUE, ...) CST <- chisq.test(t, correct = FALSE, ...) } else CST <- suppressWarnings(chisq.test(t, correct = FALSE)) if (asresid & !vector.x) ASR <- (CST$observed-CST$expected)/sqrt(CST$expected*((1-RS/GT) %*% t(1-CS/GT))) print.CrossTable.SAS <- function() { if (exists("RowData")) { cat(SpaceSep1, "|", ColData, "\n") cat(formatC(RowData, width = RWidth, format= "s"), formatC(dimnames(t)[[2]], width = CWidth, format = "s"), RowTotal, sep = " | ", collapse = "\n") } else cat(SpaceSep1, formatC(dimnames(t)[[2]], width = CWidth, format = "s"), RowTotal, sep = " | ", collapse = "\n") cat(RowSep1, rep(RowSep, ncol(t) + 1), sep = "|", collapse = "\n") ## Print table cells for (i in 1:nrow(t)) { cat(FirstCol[i], formatC(c(t[i, ], RS[i]), width = CWidth, format = "d"), sep = " | ", collapse = "\n") if (expected) cat(SpaceSep1, formatC(CST$expected[i, ], digits = digits, format = "f", width = CWidth), SpaceSep2, sep = " | ", collapse = "\n") if (prop.chisq) cat(SpaceSep1, formatC((((CST$expected[i, ]-t[i, ])^2)/CST$expected[i, ]), width = CWidth, digits = digits, format = "f"), SpaceSep2, sep = " | ", collapse = "\n") if (prop.r) cat(SpaceSep1, formatC(c(CPR[i, ], RS[i]/GT), width = CWidth, digits = digits, format = "f"), sep = " | ", collapse = "\n") if (prop.c) cat(SpaceSep1, formatC(CPC[i, ], width = CWidth, digits = digits, format = "f"), SpaceSep2, sep = " | ", collapse = "\n") if (prop.t) cat(SpaceSep1, formatC(CPT[i, ], width = CWidth, digits = digits, format = "f"), SpaceSep2, sep = " | ", collapse = "\n") cat(RowSep1, rep(RowSep, ncol(t) + 1), sep = "|", collapse = "\n") } ## Print Column Totals cat(ColTotal, formatC(c(CS, GT), width = CWidth, format = "d"), sep = " | ", collapse = "\n") if (prop.c) cat(SpaceSep1, formatC(CS/GT, width = CWidth, digits = digits, format = "f"), SpaceSep2, sep = " | ", collapse = "\n") cat(RowSep1, rep(RowSep, ncol(t) + 1), sep = "|", collapse = "\n") } ## End Of print.Crosstable.SAS function print.CrossTable.SPSS <- function() { ## similar to SPSS behaviour ## Print Column headings if (exists("RowData")) { cat(SpaceSep1, "|", ColData, "\n") cat(cat(formatC(RowData, width = RWidth, format = "s"),sep=" | ", collapse=""), cat(formatC(dimnames(t)[[2]], width = CWidth-1, format = "s"), sep=" | ", collapse=""), cat(RowTotal, sep = " | ", collapse = "\n"), sep="", collapse="") } else cat(SpaceSep1, formatC(dimnames(t)[[2]], width = CWidth, format = "s"), RowTotal, sep = " | ", collapse = "\n") cat(RowSep1, rep(RowSep, ncol(t) + 1), sep = "|", collapse = "\n") ## Print table cells for (i in 1:nrow(t)) { cat(cat(FirstCol[i], sep=" | ", collapse=""), cat(formatC(c(t[i, ], RS[i]), width = CWidth-1, format = "d"), sep = " | ", collapse = "\n"), sep="", collapse="") if (expected) cat(cat(SpaceSep1, sep=" | ", collapse=""), cat(formatC(CST$expected[i, ], digits = digits, format = "f", width = CWidth-1), sep=" | ", collapse=""), cat(SpaceSep2, sep = " | ", collapse = "\n"), sep="", collapse="") if (prop.chisq) cat(cat(SpaceSep1, sep=" | ", collapse=""), cat(formatC((((CST$expected[i, ]-t[i, ])^2)/CST$expected[i, ]), digits = digits, format = "f", width = CWidth-1), sep=" | ", collapse=""), cat(SpaceSep2, sep = " | ", collapse = "\n"), sep="", collapse="") if (prop.r) cat(cat(SpaceSep1, sep=" | ", collapse=""), cat(formatC(c(CPR[i, ]*100, 100*RS[i] / GT), width = CWidth-1, digits = digits, format = "f"), sep = "% | ", collapse = "\n"), sep="", collapse="") if (prop.c) cat(cat(SpaceSep1, sep=" | ", collapse=""), cat(formatC(CPC[i, ]*100, width = CWidth-1, digits = digits, format = "f"), sep="% | ", collapse=""), cat(SpaceSep2, sep = " | ", collapse = "\n"), sep="", collapse="") if (prop.t) cat(cat(SpaceSep1, sep=" | ", collapse=""), cat(formatC(CPT[i, ]*100, width = CWidth-1, digits = digits, format = "f"), sep="% | ", collapse=""), cat(SpaceSep2, sep = " | ", collapse = "\n"), sep="", collapse="") if (resid) cat(cat(SpaceSep1,sep=" | ",collapse = ""), cat(formatC(CST$observed[i, ]-CST$expected[i, ], digits = digits, format = "f", width = CWidth-1), sep = " | ", collapse = ""), cat(SpaceSep2,sep = " | ", collapse = "\n"),sep="",collapse="") if (sresid) cat(cat(SpaceSep1,sep=" | ",collapse = ""), cat(formatC(CST$residual[i, ], digits = digits, format = "f", width = CWidth-1), sep = " | ", collapse = ""), cat(SpaceSep2,sep = " | ", collapse = "\n"),sep="",collapse="") if (asresid) cat(cat(SpaceSep1,sep=" | ",collapse = ""), cat(formatC(ASR[i, ], digits = digits, format = "f", width = CWidth-1), sep = " | ", collapse = ""), cat(SpaceSep2,sep = " | ", collapse = "\n"),sep="",collapse="") cat(RowSep1, rep(RowSep, ncol(t) + 1), sep = "|", collapse = "\n") } ## Print Column Totals cat(cat(ColTotal,sep=" | ",collapse=""), cat(formatC(c(CS, GT), width = CWidth-1, format = "d"), sep = " | ", collapse = "\n"),sep="",collapse="") if (prop.c) cat(cat(SpaceSep1,sep=" | ",collapse=""), cat(formatC(100*CS/GT, width = CWidth-1, digits = digits, format = "f"),sep = "% | ", collapse = ""), cat(SpaceSep2,sep = " | ", collapse = "\n"),sep="",collapes="") cat(RowSep1, rep(RowSep, ncol(t) + 1), sep = "|", collapse = "\n") } ## End of print.CrossTable.SPSS function ## Print Function For 1 X N Vector In SAS Format print.CrossTable.vector.SAS <- function() { if (length(t) > max.width) { ## set breakpoints for output based upon max.width final.row <- length(t) %% max.width max <- length(t) - final.row ## Define breakpoint indices for each row start <- seq(1, max, max.width) end <- start + (max.width - 1) ## Add final.row if required if (final.row > 0) { start <- c(start, end[length(end)] + 1) end <- c(end, end[length(end)] + final.row) } } else { ## Each value printed horizontally in a single row start <- 1 end <- length(t) } SpaceSep3 <- paste(SpaceSep2, " ", sep = "") for (i in 1:length(start)) { ## print column labels cat(SpaceSep2, formatC(dimnames(t)[[2]][start[i]:end[i]], width = CWidth, format = "s"), sep = " | ", collapse = "\n") cat(SpaceSep3, rep(RowSep, (end[i] - start[i]) + 1), sep = "|", collapse = "\n") cat(SpaceSep2, formatC(t[, start[i]:end[i]], width = CWidth, format = "d"), sep = " | ", collapse = "\n") cat(SpaceSep2, formatC(CPT[, start[i]:end[i]], width = CWidth, digits = digits, format = "f"), sep = " | ", collapse = "\n") cat(SpaceSep3, rep(RowSep, (end[i] - start[i]) + 1), sep = "|", collapse = "\n") cat("\n\n") } } ## End of print.Crosstable.vector.SAS function ## Print function for 1 X N vector in SPSS format print.CrossTable.vector.SPSS <- function() { if (length(t) > max.width) { ## set breakpoints for output based upon max.width final.row <- length(t) %% max.width max <- length(t) - final.row ## Define breakpoint indices for each row start <- seq(1, max, max.width) end <- start + (max.width - 1) ## Add final.row if required if (final.row > 0) { start <- c(start, end[length(end)] + 1) end <- c(end, end[length(end)] + final.row) } } else { ## Each value printed horizontally in a single row start <- 1 end <- length(t) } SpaceSep3 <- paste(SpaceSep2, " ", sep = "") for (i in 1:length(start)) { cat(cat(SpaceSep2,sep=" | ",collapse=""), cat(formatC(dimnames(t)[[2]][start[i]:end[i]], width = CWidth-1, format = "s"), sep = " | ", collapse = "\n"), sep="",collapse="") cat(SpaceSep3, rep(RowSep, (end[i] - start[i]) + 1), sep = "|", collapse = "\n") cat(cat(SpaceSep2,sep=" | ",collapse=""), cat(formatC(t[, start[i]:end[i]], width = CWidth-1, format = "d"), sep = " | ", collapse = "\n"), sep="",collapse="") cat(cat(SpaceSep2, sep=" | ",collapse=""), cat(formatC(CPT[, start[i]:end[i]] * 100, width = CWidth-1, digits = digits, format = "f"), sep = "% | ", collapse = ""),sep="",collapse="\n") cat(SpaceSep3, rep(RowSep, (end[i] - start[i]) + 1), sep = "|", collapse = "\n") } ## End of for (i in 1:length(start)) if (GT < TotalN) cat("\nNumber of Missing Observations: ",TotalN-GT," (",100*(TotalN-GT)/TotalN,"%)\n",sep="") } ## End of print.CrossTable.vector.SPSS Function print.statistics <- function() { ## Print Statistics if (chisq) { cat(rep("\n", 2)) cat("Statistics for All Table Factors\n\n\n") cat(CST$method,"\n") cat("------------------------------------------------------------\n") cat("Chi^2 = ", CST$statistic, " d.f. = ", CST$parameter, " p = ", CST$p.value, "\n\n") if (all(dim(t) == 2)) { cat(CSTc$method,"\n") cat("------------------------------------------------------------\n") cat("Chi^2 = ", CSTc$statistic, " d.f. = ", CSTc$parameter, " p = ", CSTc$p.value, "\n") } } ## Perform McNemar tests if (mcnemar) { McN <- mcnemar.test(t, correct = FALSE) cat(rep("\n", 2)) cat(McN$method,"\n") cat("------------------------------------------------------------\n") cat("Chi^2 = ", McN$statistic, " d.f. = ", McN$parameter, " p = ", McN$p.value, "\n\n") if (all(dim(t) == 2)) { McNc <- mcnemar.test(t, correct = TRUE) cat(McNc$method,"\n") cat("------------------------------------------------------------\n") cat("Chi^2 = ", McNc$statistic, " d.f. = ", McNc$parameter, " p = ", McNc$p.value, "\n") } } ## Perform Fisher Tests if (fisher) { cat(rep("\n", 2)) FTt <- fisher.test(t, alternative = "two.sided") if (all(dim(t) == 2)) { FTl <- fisher.test(t, alternative = "less") FTg <- fisher.test(t, alternative = "greater") } cat("Fisher's Exact Test for Count Data\n") cat("------------------------------------------------------------\n") if (all(dim(t) == 2)) { cat("Sample estimate odds ratio: ", FTt$estimate, "\n\n") cat("Alternative hypothesis: true odds ratio is not equal to 1\n") cat("p = ", FTt$p.value, "\n") cat("95% confidence interval: ", FTt$conf.int, "\n\n") cat("Alternative hypothesis: true odds ratio is less than 1\n") cat("p = ", FTl$p.value, "\n") cat("95% confidence interval: ", FTl$conf.int, "\n\n") cat("Alternative hypothesis: true odds ratio is greater than 1\n") cat("p = ", FTg$p.value, "\n") cat("95% confidence interval: ", FTg$conf.int, "\n\n") } else { cat("Alternative hypothesis: two.sided\n") cat("p = ", FTt$p.value, "\n") } } ## End Of If(Fisher) Loop cat(rep("\n", 2)) ## Create list of results for invisible() CT <- list(t = t, prop.row = CPR, prop.col = CPC, prop.tbl = CPT) if (any(chisq, fisher, mcnemar)) { if (all(dim(t) == 2)) { if (chisq) CT <- c(CT, list(chisq = CST, chisq.corr = CSTc)) if (fisher) CT <- c(CT, list(fisher.ts = FTt, fisher.tl = FTl, fisher.gt = FTg)) if (mcnemar) CT <- c(CT, list(mcnemar = McN, mcnemar.corr = McNc)) } else { if (chisq) CT <- c(CT, list(chisq = CST)) if (fisher) CT <- c(CT, list(fisher.ts = FTt)) if (mcnemar) CT <- c(CT, list(mcnemar = McN)) } } ## End of if(any(chisq, fisher, mcnemar)) loop ## return list(CT) invisible(CT) } ## End of print.statistics function ## Printing the tables if (format=="SAS") { ## Print Cell Layout cat(rep("\n", 2)) cat(" Cell Contents\n") cat("|-------------------------|\n") cat("| N |\n") if (expected) cat("| Expected N |\n") if (prop.chisq) cat("| Chi-square contribution |\n") if (prop.r) cat("| N / Row Total |\n") if (prop.c) cat("| N / Col Total |\n") if (prop.t) cat("| N / Table Total |\n") cat("|-------------------------|\n") cat(rep("\n", 2)) cat("Total Observations in Table: ", GT, "\n") cat(rep("\n", 2)) if (!vector.x) print.CrossTable.SAS() else print.CrossTable.vector.SAS() print.statistics() } else if (format == "SPSS") { ## Print Cell Layout cat("\n") cat(" Cell Contents\n") cat("|-------------------------|\n") cat("| Count |\n") if (!vector.x) { if (expected) cat("| Expected Values |\n") if (prop.chisq) cat("| Chi-square contribution |\n") if (prop.r) cat("| Row Percent |\n") if (prop.c) cat("| Column Percent |\n") if (prop.t) cat("| Total Percent |\n") if (resid) cat("| Residual |\n") if (sresid) cat("| Std Residual |\n") if (asresid) cat("| Adj Std Resid |\n") } else cat("| Row Percent |\n") cat("|-------------------------|\n") cat("\n") cat("Total Observations in Table: ", GT, "\n") cat("\n") if (!vector.x) print.CrossTable.SPSS() else print.CrossTable.vector.SPSS() print.statistics() if (any(dim(t) >= 2) & any(chisq,mcnemar,fisher)) { MinExpF = min(CST$expected) cat(' Minimum expected frequency:',MinExpF,"\n") NMinExpF = length(CST$expected[which(CST$expected<5)]) if (NMinExpF > 0) { NCells = length(CST$expected) cat('Cells with Expected Frequency < 5: ',NMinExpF,' of ',NCells," (",100*NMinExpF/NCells,"%)\n",sep="") } cat("\n") } ## End of if (any(dim(t)... } ## End of if(format=="SPSS") loop else stop("unknown format") } ## End of the main function Crosstable.R gmodels/R/percentile.R0000644000176000001440000000027511772706414014427 0ustar ripleyuserspercentile <- function(x, distn, include.observed=FALSE) { if(include.observed) distn <- c(x, distn) n <- length(distn) return(findInterval(x, distn[order(distn)]) / n) } gmodels/R/fast.prcomp.R0000644000176000001440000000705010533135124014513 0ustar ripleyusers# $Id: fast.prcomp.R 1025 2006-11-28 22:38:11Z warnes $ # The current implementation of the function svd() in S-Plus and R is # much slower when operating on a matrix with a large number of # columns than on the transpose of this matrix, which has a large # number of rows. R's La.svd does not suffer from this problem. # # For R, the simple solution is to use La.svd instead of svd. For # S-Plus the solution is to check if the matrix is wider than tall, # and to SVD on the transpose when this is the case. if(exists("is.R") && is.R()==TRUE) { # This fast.prcomp() function is a slight modification of the # standard R prcomp function from package mva. It uses La.svd instead # of the standard svd. Consequently, it can be used with matrices # with many rows without a performance penalty. fast.prcomp <- function (x, retx = TRUE, center = TRUE, scale. = FALSE, tol = NULL) { x <- as.matrix(x) x <- scale(x, center = center, scale = scale.) s <- La.svd(x, nu = 0) if (!is.null(tol)) { rank <- sum(s$d > (s$d[1] * tol)) if (rank < ncol(x)) s$vt <- s$vt[, 1:rank, drop = FALSE] } s$d <- s$d/sqrt(max(1, nrow(x) - 1)) dimnames(s$vt) <- list(paste("PC", seq(len = nrow(s$vt)), sep = ""), colnames(x) ) r <- list(sdev = s$d, rotation = t(s$vt) ) if (retx) r$x <- x %*% t(s$vt) class(r) <- "prcomp" r } fast.svd <- function( x, nu = min(n, p), nv = min(n, p), ...) { x <- as.matrix(x) dx <- dim(x) n <- dx[1] p <- dx[2] retval <- La.svd(x, nu=nu, nv=nv, ... ) retval$v <- t(retval$vt) retval$vt <- NULL retval } } else { # The fast.svd() function checks if the number of columns is # larger than the number of rows. When this is the case, it # transposes the matrix, calles svd, and then flips the returned # u and v matrixes. Otherwise it just calls svd. # # This permits an SVD to be computed efficiently regardless of whether # n >>p or vice versa. # The fast.prcomp() function is simply a copy of the standard R # prcomp function from package mva which calls fast.svd instead of the # standard svd. Consequently, it can be used with matrices with many # rows without a performance penalty. fast.prcomp <- function (x, retx = TRUE, center = TRUE, scale. = FALSE, tol = NULL) { x <- as.matrix(x) x <- scale(x, center = center, scale = scale.) s <- fast.svd(x, nu = 0) if (!is.null(tol)) { rank <- sum(s$d > (s$d[1] * tol)) if (rank < ncol(x)) s$v <- s$v[, 1:rank, drop = FALSE] } s$d <- s$d/sqrt(max(1, nrow(x) - 1)) dimnames(s$v) <- list(colnames(x), paste("PC", seq(len = ncol(s$v)), sep = "")) r <- list(sdev = s$d, rotation = s$v) if (retx) r$x <- x %*% s$v class(r) <- "prcomp" r } fast.svd <- function( x, nu = min(n, p), nv = min(n, p), ...) { x <- as.matrix(x) dx <- dim(x) n <- dx[1] p <- dx[2] if( p <= n ) return( svd( x, nu, nv, ... ) ) else { s <- svd( t(x), nu=nv, nv=nu, ...) retval <- list() retval$d <- s$d retval$u <- s$v retval$v <- s$u return(retval) } } NULL } gmodels/R/glh.test.R0000644000176000001440000000566310451013036014013 0ustar ripleyusers# $Id: glh.test.R 625 2005-06-09 14:20:30Z nj7w $ glh.test <- function( reg, cm, d=rep(0, nrow(cm)) ) { if( !is.matrix(cm) && !is.data.frame(cm) ) cm <- matrix(cm, nrow=1) if ( !( "lm" %in% class(reg) ) ) stop("Only defined for lm,glm objects") bhat <- summary.lm(reg)$coefficients[,1,drop=FALSE] XpX <- summary.lm(reg)$cov.unscaled df <- reg$df.residual msr <- summary.lm(reg)$sigma # == SSE / (n-p) r <- nrow(cm) if ( ncol(cm) != length(bhat) ) stop( paste( "\n Dimension of ", deparse( substitute( cm ) ), ": ", paste( dim(cm), collapse="x" ), ", not compatible with no of parameters in ", deparse( substitute( reg ) ), ": ", length(bhat), sep="" ) ) # -1 # (Cb - d)' ( C (X'X) C' ) (Cb - d) / r # F = --------------------------------------- # SSE / (n-p) # Fstat <- t(cm %*% bhat - d) %*% solve((cm %*% XpX %*% t(cm))) %*% (cm %*% bhat - d) / r / msr^2 p <- 1-pf(Fstat,r,df) retval <- list() retval$call <- match.call() retval$statistic <- c(F=Fstat) retval$parameter <- c(df1=r,df2=df) retval$p.value <- p retval$conf.int <- NULL retval$estimate <- cm%*%bhat retval$null.value <- d retval$method <- "Test of General Linear Hypothesis" retval$data.name <- deparse(substitute(reg)) retval$matrix <- cm colnames(retval$matrix) <- names(reg$coef) class(retval) <- c("glh.test","htest") retval } print.glh.test <- function(x, digits = 4, ... ) { cat("\n") cat("\t",x$method, prefix = "\t") cat("\n") cat("Call:\n") print(x$call) if (!is.null(x$statistic)) cat(names(x$statistic), " = ", format(round(x$statistic, 4)), ", ", sep = "") if (!is.null(x$parameter)) cat(paste(names(x$parameter), " = ", format(round(x$parameter, 3)), ",", sep = ""), "") cat("p-value =", format.pval(x$p.value, digits = digits), "\n") cat("\n") } summary.glh.test <- function(object, digits = 4, ... ) { cat("\n") cat("\t",object$method, prefiobject = "\t") cat("\n") cat("Regression: ", object$data.name, "\n") cat("\n") cat("Null Hypothesis: C %*% Beta-hat = d \n") cat("\n") cat("C matrix: \n") print(object$matrix, digits=digits) cat("\n") cat("d vector: \n") print(object$null.value, digits=digits) cat("\n") cat("C %*% Beta-hat: \n") print(c(object$estimate)) cat("\n") if (!is.null(object$statistic)) cat(names(object$statistic), " = ", format(round(object$statistic, 4)), ", ", sep = "") if (!is.null(object$parameter)) cat(paste(names(object$parameter), " = ", format(round(object$parameter, 3)), ",", sep = ""), "") cat("p-value =", format.pval(object$p.value, digits = digits), "\n") cat("\n") } gmodels/R/coefFrame.R0000644000176000001440000000132410451013036014140 0ustar ripleyusers# $Id: coefFrame.R 625 2005-06-09 14:20:30Z nj7w $ coefFrame <- function (mod, data, by = NULL, fit.on = TRUE, fitfun, keep.unused.levels = TRUE, byvar.sep = "\001" , ...) { fit.on <- eval(substitute(fit.on), data, parent.frame()) out <- frameApply(data, on = intersect(all.vars(mod), names(data)), by = by, subset = fit.on, byvar.sep = byvar.sep, fun = function(sub.dat, ...) { fit <- try(fitfun(mod, data = sub.dat, ...), silent = TRUE) if (inherits(fit, "try-error")) return(fit) outi <- coef(fit) outi }, ...) if (keep.unused.levels) out <- unique(merge(data[by], out, all.x = TRUE)) out } gmodels/R/estimable.R0000644000176000001440000002010711201207000014204 0ustar ripleyusers## $Id: estimable.R 1333 2009-05-09 05:00:47Z warnes $ estimable <- function (obj, cm, beta0, conf.int=NULL, show.beta0, ...) { UseMethod("estimable") } estimable.default <- function (obj, cm, beta0, conf.int=NULL, show.beta0, joint.test=FALSE, ...) { if (is.matrix(cm) || is.data.frame(cm)) { cm <- t(apply(cm, 1, .to.est, obj=obj)) } else if(is.list(cm)) { cm <- matrix(.to.est(obj, cm), nrow=1) } else if(is.vector(cm)) { cm <- matrix(.to.est(obj, cm), nrow=1) } else { stop("`cm' argument must be of type vector, list, or matrix.") } if(missing(show.beta0)) { if(!missing(beta0)) show.beta0=TRUE else show.beta0=FALSE } if (missing(beta0)) { beta0 = rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm))) } if (joint.test==TRUE) { .wald(obj, cm, beta0) } else { if ("lme" %in% class(obj)) { stat.name <- "t.stat" cf <- summary(obj)$tTable rho <- summary(obj)$cor vcv <- rho * outer(cf[, 2], cf[, 2]) tmp <- cm tmp[tmp==0] <- NA df.all <- t(abs(t(tmp) * obj$fixDF$X)) df <- apply(df.all, 1, min, na.rm=TRUE) problem <- apply(df.all !=df, 1, any, na.rm=TRUE) if (any(problem)) warning(paste("Degrees of freedom vary among parameters used to ", "construct linear contrast(s): ", paste((1:nrow(tmp))[problem], collapse=", "), ". Using the smallest df among the set of parameters.", sep="")) } else if ("lm" %in% class(obj)) { stat.name <- "t.stat" cf <- summary.lm(obj)$coefficients vcv <- summary.lm(obj)$cov.unscaled * summary.lm(obj)$sigma^2 df <- obj$df.residual if ("glm" %in% class(obj)) { vcv <- summary(obj)$cov.scaled if(family(obj)[1] %in% c("poisson", "binomial")) { stat.name <- "X2.stat" df <- 1 } else { stat.name <- "t.stat" df <- obj$df.residual } } } else if ("geese" %in% class(obj)) { stat.name <- "X2.stat" cf <- summary(obj)$mean vcv <- obj$vbeta df <- 1 } else if ("gee" %in% class(obj)) { stat.name <- "X2.stat" cf <- summary(obj)$coef vcv <- obj$robust.variance df <- 1 } else { stop("obj must be of class 'lm', 'glm', 'aov', 'lme', 'gee', 'geese' or 'nlme'") } if (is.null(cm)) cm <- diag(dim(cf)[1]) if (!dim(cm)[2]==dim(cf)[1]) stop(paste("\n Dimension of ", deparse(substitute(cm)), ": ", paste(dim(cm), collapse="x"), ", not compatible with no of parameters in ", deparse(substitute(obj)), ": ", dim(cf)[1], sep="")) ct <- cm %*% cf[, 1] ct.diff <- cm %*% cf[, 1] - beta0 vc <- sqrt(diag(cm %*% vcv %*% t(cm))) if (is.null(rownames(cm))) rn <- paste("(", apply(cm, 1, paste, collapse=" "), ")", sep="") else rn <- rownames(cm) switch(stat.name, t.stat={ prob <- 2 * (1 - pt(abs(ct.diff/vc), df)) }, X2.stat={ prob <- 1 - pchisq((ct.diff/vc)^2, df=1) }) if (stat.name=="X2.stat") { retval <- cbind(hyp=beta0, est=ct, stderr=vc, "X^2 value"=(ct.diff/vc)^2, df=df, prob=1 - pchisq((ct.diff/vc)^2, df=1)) dimnames(retval) <- list(rn, c("beta0", "Estimate", "Std. Error", "X^2 value", "DF", "Pr(>|X^2|)")) } else if (stat.name=="t.stat") { retval <- cbind(hyp=beta0, est=ct, stderr=vc, "t value"=ct.diff/vc, df=df, prob=2 * (1 - pt(abs(ct.diff/vc), df))) dimnames(retval) <- list(rn, c("beta0", "Estimate", "Std. Error", "t value", "DF", "Pr(>|t|)")) } if (!is.null(conf.int)) { if (conf.int <=0 || conf.int >=1) stop("conf.int should be between 0 and 1. Usual values are 0.95, 0.90") alpha <- 1 - conf.int switch(stat.name, t.stat={ quant <- qt(1 - alpha/2, df) }, X2.stat={ quant <- qt(1 - alpha/2, 100) }) nm <- c(colnames(retval), "Lower.CI", "Upper.CI") retval <- cbind(retval, lower=ct.diff - vc * quant, upper=ct.diff + vc * quant) colnames(retval) <- nm } rownames(retval) <- make.unique(rownames(retval)) retval <- as.data.frame(retval) if(!show.beta0) retval$beta0 <- NULL return(retval) } } .wald <- function (obj, cm, beta0=rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm)))) { if (!is.matrix(cm) && !is.data.frame(cm)) cm <- matrix(cm, nrow=1) df <- nrow(cm) if ("geese" %in% class(obj)) { cf <- obj$beta vcv <- obj$vbeta } else if ("gee" %in% class(obj)) { cf <- summary(obj)$coef vcv <- obj$robust.variance } else if ("lm" %in% class(obj)) { cf <- summary.lm(obj)$coefficients[, 1] if ("glm" %in% class(obj)) vcv <- summary(obj)$cov.scaled else vcv <- summary.lm(obj)$cov.unscaled * summary.lm(obj)$sigma^2 } else if ("lme" %in% class(obj)) { s.o <- summary(obj) cf <- s.o$tTable[,1] se <- s.o$tTable[, 2] rho <- s.o$cor vcv <- rho * outer(se, se) } else stop("obj must be of class 'lm', 'glm', 'aov', 'gee', 'geese', or 'lme'.") u <- (cm %*% cf)-beta0 vcv.u <- cm %*% vcv %*% t(cm) W <- t(u) %*% solve(vcv.u) %*% u prob <- 1 - pchisq(W, df=df) retval <- as.data.frame(cbind(W, df, prob)) names(retval) <- c("X2.stat", "DF", "Pr(>|X^2|)") print(as.data.frame(retval)) } estimable.mer <- function (obj, cm, beta0, conf.int=NULL, show.beta0, sim.mer=TRUE, n.sim=1000, ...) { if (is.matrix(cm) || is.data.frame(cm)) { cm <- t(apply(cm, 1, .to.est, obj=obj)) } else if(is.list(cm)) { cm <- matrix(.to.est(obj, cm), nrow=1) } else if(is.vector(cm)) { cm <- matrix(.to.est(obj, cm), nrow=1) } else { stop("'cm' argument must be of type vector, list, or matrix.") } if(missing(show.beta0)) { if(!missing(beta0)) show.beta0=TRUE else show.beta0=FALSE } if (missing(beta0)) { beta0 = rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm))) } if ("mer" %in% class(obj)) { if(sim.mer) return(est.mer(obj=obj, cm=cm, beta0=beta0, conf.int=conf.int, show.beta0=show.beta0, n.sim=n.sim)) stat.name <- "mer" cf <- as.matrix(fixef(obj)) vcv <- as.matrix(vcov(obj)) df <- NA } else { stop("obj is not of class mer") } if (is.null(rownames(cm))) rn <- paste("(", apply(cm, 1, paste, collapse=" "), ")", sep="") else rn <- rownames(cm) ct <- cm %*% cf[, 1] ct.diff <- cm %*% cf[, 1] - beta0 vc <- sqrt(diag(cm %*% vcv %*% t(cm))) retval <- cbind(hyp=beta0, est=ct, stderr=vc, "t value"=ct.diff/vc) dimnames(retval) <- list(rn, c("beta0", "Estimate", "Std. Error", "t value")) rownames(retval) <- make.unique(rownames(retval)) retval <- as.data.frame(retval) if(!show.beta0) retval$beta0 <- NULL return(retval) } gmodels/R/fit.contrast.R0000644000176000001440000001260411201207001014661 0ustar ripleyusers# $Id: fit.contrast.R 1333 2009-05-09 05:00:47Z warnes $ fit.contrast.lm <- function(model, varname, coeff, showall=FALSE, conf.int=NULL, df=FALSE, ...) { # check class of model if( !(any(class(model) %in% c("lm", "aov", "lme") ) )) stop("contrast.lm can only be applied to objects inheriting from 'lm'", "and 'lme' (eg: lm,glm,aov,lme).") # make sure we have the NAME of the variable if(!is.character(varname)) varname <- deparse(substitute(varname)) # make coeff into a matrix if(!is.matrix(coeff)) { coeff <- matrix(coeff, nrow=1) } # make sure columns are labeled if (is.null(rownames(coeff))) { rn <- vector(length=nrow(coeff)) for(i in 1:nrow(coeff)) rn[i] <- paste(" c=(",paste(coeff[i,],collapse=" "), ")") rownames(coeff) <- rn } # now convert into the proper form for the contrast matrix cmat <- make.contrasts(coeff, ncol(coeff) ) cn <- paste(" C",1:ncol(cmat),sep="") cn[1:nrow(coeff)] <- rownames(coeff) colnames(cmat) <- cn # recall fitting method with the specified contrast m <- model$call if(is.null(m$contrasts)) m$contrasts <- list() m$contrasts[[varname]] <- cmat if(is.R()) r <- eval(m, parent.frame()) else r <- eval(m) # now return the correct elements .... if( 'lme' %in% class(model) ) { est <- r$coefficients$fixed se <- sqrt(diag(r$varFix)) tval <- est/se df.lme <- r$fixDF$X retval <- cbind( "Estimate"= est, "Std. Error"= se, "t-value"= tval, "Pr(>|t|)"= 2 * (1 - pt(abs(tval), df.lme)), "DF"=df.lme ) } else if('glm' %in% class(model)) { smodel <- summary.glm(r) retval <- cbind(coef(smodel), "DF"=smodel$df[2]) } else # lm, aov { smodel <- summary.lm(r) retval <- cbind(coef(smodel), "DF"=smodel$df[2]) } if( !showall ) { if( !is.R() && ncol(cmat)==1 ) { retval <- retval[varname,,drop=FALSE] rownames(retval) <- rn } else { rn <- paste(varname,rownames(coeff),sep="") ind <- match(rn,rownames(retval)) retval <- retval[ind,,drop=FALSE] } } if(!is.null(conf.int)) # add confidence intervals { alpha <- 1-conf.int retval <- cbind( retval, "lower CI"=retval[,1] - qt(1-alpha/2,retval[,5])*retval[,2], "upper CI"=retval[,1] + qt(1-alpha/2,retval[,5])*retval[,2] ) } if(!df) return(retval[,-5,drop=FALSE]) else return(retval) } # fit.contrast.lme and fit.contrast.mer are necessary because # 'lme' and 'mer' objects do not inherit from 'lm'. # # **Make sure that the argument list *exactly* matches the one # for fit.contrast.lm() above.** # fit.contrast.lme <- function(model, varname, coeff, showall=FALSE, conf.int=NULL, df=FALSE, ...) { require(nlme) fit.contrast.lm(model, varname, coeff, showall, conf.int, df) } # I made rather dramatic changes here and do all calculations in fit.contrast.mer rather than # fit.contrast.lm because of the simulation extras ... added sim.mer and n.sim to the parameter list fit.contrast.mer <- function(model, varname, coeff, showall=FALSE, conf.int=NULL, sim.mer=TRUE, n.sim=1000, ...) { require(lme4) # make sure we have the NAME of the variable if(!is.character(varname)) varname <- deparse(substitute(varname)) # make coeff into a matrix if(!is.matrix(coeff)) { coeff <- matrix(coeff, nrow=1) } # make sure columns are labeled if (is.null(rownames(coeff))) { rn <- vector(length=nrow(coeff)) for(i in 1:nrow(coeff)) rn[i] <- paste(" c=(",paste(coeff[i,],collapse=" "), ")") rownames(coeff) <- rn } # now convert into the proper form for the contrast matrix cmat <- make.contrasts(coeff, ncol(coeff) ) cn <- paste(" C",1:ncol(cmat),sep="") cn[1:nrow(coeff)] <- rownames(coeff) colnames(cmat) <- cn m <- model@call if(is.null(m$contrasts)) m$contrasts <- list() m$contrasts[[varname]] <- cmat if(is.R()) r <- eval(m, parent.frame()) else r <- eval(m) # now return the correct elements .... r.effects <- fixef(r) n <- length(r.effects) if(sim.mer) { retval <- est.mer(obj = r, cm = diag(n), beta0 = rep(0, n), conf.int = conf.int, show.beta0 = FALSE, n.sim=n.sim) rownames(retval) <- names(r.effects) }else{ if(!is.null(conf.int)) warning("Confidence interval calculation for mer objects requires simulation -- use sim.mer = TRUE") est <- fixef(r) se <- sqrt(diag(as.matrix(vcov(r)))) tval <- est/se retval <- cbind( "Estimate"= est, "Std. Error"= se, "t-value"= tval ) } if( !showall ) { if( !is.R() && ncol(cmat)==1 ) { retval <- retval[varname,,drop=FALSE] rownames(retval) <- rn }else{ rn <- paste(varname,rownames(coeff),sep="") ind <- match(rn,rownames(retval)) retval <- retval[ind,,drop=FALSE] } } return(retval) } fit.contrast <- function(model, varname, coeff, ...) UseMethod("fit.contrast") gmodels/R/est.mer.R0000644000176000001440000000302011772723174013643 0ustar ripleyusers# est.mer.R # generate estimable output for mer objects using mcmcsamp() # Randall Johnson # Laboratory of Genomic Diversity at NCI Frederick # SAIC Frederick, Inc # Created April 25, 2006 # Updated 2012-04-19 for S4 version of lmer object est.mer <- function(obj, cm, beta0, conf.int, show.beta0, n.sim) { samp <- lme4:::mcmcsamp(obj, n.sim) ## samp.summ <- summary(samp) samp.cm <- t(cm %*% samp@fixef) # calculate requested statistics est <- apply(samp.cm, 2, mean) stderr <- apply(samp.cm, 2, sd) pval <- sapply(1:length(beta0), function(i){percentile(beta0[i], samp.cm[,i])}) pval <- ifelse(pval <= .5, 2*pval, 2*(1-pval)) if(is.null(conf.int)) { lower.ci <- NULL upper.ci <- NULL } else { alpha <- 1-conf.int samp.ci <- sapply(1:length(beta0), function(i) { quantile(samp.cm[,i], probs=c(alpha/2, 1-alpha/2)) } ) lower.ci <- samp.ci[1,] upper.ci <- samp.ci[2,] } # return results if(!show.beta0) beta0 <- NULL samp.stats <- cbind('beta0' = beta0, 'Estimate' = est, 'Std. Error' = stderr, 'p value' = pval, 'Lower.CI' = lower.ci, 'Upper.CI' = upper.ci) row.names(samp.stats) <- paste('(', apply(cm, 1, paste, collapse=" "), ')', sep='') return(samp.stats) } gmodels/R/make.contrasts.R0000644000176000001440000000212110451013036015201 0ustar ripleyusers# $Id: make.contrasts.R 625 2005-06-09 14:20:30Z nj7w $ "make.contrasts" <- function (contr, how.many=ncol(contr)) { if(!is.matrix(contr)) contr <- matrix(contr,ncol=length(contr)) if(nrow(contr)+1 > how.many) stop("Too many contrasts specified. Must be less than the number of factor levels (columns).") value <- as.matrix(ginv(contr)) # requires library(MASS) if (nrow(value) != how.many) stop("wrong number of contrast matrix rows") n1 <- if (missing(how.many)) how.many - 1 else how.many nc <- ncol(value) if (nc < n1) { cm <- qr(cbind(1, value)) if (cm$rank != nc + 1) stop("singular contrast matrix") cm <- qr.qy(cm, diag(how.many))[, 2:how.many, drop=FALSE] cm[, 1:nc] <- value } else cm <- value[, 1:n1, drop = FALSE] colnames(cm) <- paste( "C", 1:ncol(cm), sep="") rownames(cm) <- paste( "V", 1:nrow(cm), sep="") if(!is.null(rownames(contr))) { namelist <- rownames(contr) colnames(cm)[1:length(namelist)] <- namelist } if(!is.null(colnames(contr))) rownames(cm) <- colnames(contr) cm } gmodels/R/to.est.R0000644000176000001440000000256411037667377013524 0ustar ripleyusers# to.est.R # return a vector for cm in estimable() # Randy Johnson # Laboratory of Genomic Diversity at NCI-Frederick .to.est <- function(obj, params) { if('lme' %in% class(obj) | 'mer' %in% class(obj)) { eff.obj <- fixef(obj) } else if('geese' %in% class(obj)) { eff.obj <- obj$beta } else { eff.obj <- coef(obj) } if(is.null(obj)) stop("Error obtaining model coefficients") est <- rep(0, length(eff.obj)) names(est) <- names(eff.obj) if(!missing(params)) { if(is.null(names(params))) if(length(params)==length(est)) names(params) <- names(est) else stop("'param' has no names and does not match number of coefficients of model. Unable to construct coefficient vector") else { matches <- names(params) %in% names(est) if(!(all(matches))) stop( '\n\t', 'Invalid parameter name(s): ', paste(names(params)[!matches], collapse=', '), '\n\t', 'Valid names are: ', paste(names(est), collapse=', ') ) } if(is.list(params)) est[names(params)] <- unlist(params) else est[names(params)] <- params } return(est) } gmodels/R/estimable.mlm.R0000644000176000001440000000166110651763663015032 0ustar ripleyusers`estimable.mlm` <- function (obj, cm, beta0, conf.int=NULL, show.beta0, ...) { coef <- coef(object) ny <- ncol(coef) effects <- object$effects resid <- object$residuals fitted <- object$fitted ynames <- colnames(coef) if (is.null(ynames)) { lhs <- object$terms[[2]] if (mode(lhs) == "call" && lhs[[1]] == "cbind") ynames <- as.character(lhs)[-1] else ynames <- paste("Y", seq(ny), sep = "") } value <- vector("list", ny) names(value) <- paste("Response", ynames) cl <- oldClass(object) class(object) <- cl[match("mlm", cl):length(cl)][-1] for (i in seq(ny)) { object$coefficients <- coef[, i] object$residuals <- resid[, i] object$fitted.values <- fitted[, i] object$effects <- effects[, i] object$call$formula[[2]] <- object$terms[[2]] <- as.name(ynames[i]) value[[i]] <- estimable(obj, cm, beta0, conf.int=NULL, show.beta0, ...) } class(value) <- "listof" value } gmodels/R/ci.R0000644000176000001440000000574512217321564012671 0ustar ripleyusers# $Id: ci.R 1525 2012-04-19 22:05:48Z warnes $ ci <- function(x, confidence=0.95,alpha=1-confidence,...) UseMethod("ci") ci.default <- function(x, confidence=0.95,alpha=1-confidence,na.rm=FALSE,...) { est <- mean(x, na.rm=na.rm) stderr <- sd(x, na.rm=na.rm)/sqrt(nobs(x)); ci.low <- est + qt(alpha/2, nobs(x)-1) * stderr ci.high <- est - qt(alpha/2, nobs(x)-1) * stderr retval <- c( Estimate=est, "CI lower"=ci.low, "CI upper"=ci.high, "Std. Error"=stderr ) retval } ci.binom <- function(x, confidence=0.95,alpha=1-confidence,...) { if( !(all(x) %in% c(0,1)) ) stop("Binomial values must be either 0 or 1.") est <- mean(x, na.rm=TRUE) n <- nobs(x) stderr <- sqrt(est*(1-est)/n) ci.low <- qbinom(p=alpha/2, prob=est, size=n)/n ci.high <- qbinom(p=1-alpha/2, prob=est, size=n)/n retval <- cbind(Estimate=est, "CI lower"=ci.low, "CI upper"=ci.high, "Std. Error"= stderr ) retval } ci.lm <- function(x,confidence=0.95,alpha=1-confidence,...) { x <- summary(x) est <- coef(x)[,1] ; ci.low <- est + qt(alpha/2, x$df[2]) * coef(x)[,2] ; ci.high <- est - qt(alpha/2, x$df[2]) * coef(x)[,2] ; retval <- cbind(Estimate=est, "CI lower"=ci.low, "CI upper"=ci.high, "Std. Error"= coef(x)[,2], "p-value" = coef(x)[,4]) retval } ci.lme <- function(x,confidence=0.95,alpha=1-confidence,...) { x <- summary(x) est <- x$tTable[,"Value"] ; ci.low <- est + qt(alpha/2, x$tTable[,"DF"]) * x$tTable[,"Std.Error"] ; ci.high <- est - qt(alpha/2, x$tTable[,"DF"]) * x$tTable[,"Std.Error"] ; retval <- cbind(Estimate=est, "CI lower"=ci.low, "CI upper"=ci.high, "Std. Error"= x$tTable[,"Std.Error"], "DF" = x$tTable[,"DF"], "p-value" = x$tTable[,"p-value"]) rownames(retval) <- rownames(x$tTable) retval } ci.mer <- function (x, confidence = 0.95, alpha = 1 - confidence, sim.mer = TRUE, n.sim = 1e4, ...) { x.effects <- x@fixef n <- length(x.effects) retval <- est.mer(obj = x, cm = diag(n), beta0 = rep(0, n), conf.int = confidence, show.beta0 = FALSE, n.sim = n.sim) retval <- retval[, c("Estimate", "Lower.CI", "Upper.CI", "Std. Error", "p value"), drop=FALSE ] colnames(retval)[c(2:3, 5)] <- c("CI lower", "CI upper", "p-value") rownames(retval) <- names(x.effects) retval } gmodels/MD50000644000176000001440000000235012217322402012237 0ustar ripleyusersa609b99c5b4ddb2b6baf97e1f635a499 *ChangeLog c6142ff5ab51af204740e52abd1d910a *DESCRIPTION 736b039fe8bf13ca85ca4181d9f5d1d5 *NAMESPACE fce721822110b9cf1e2677963fe44d88 *NEWS 8463467f912f147197c631c44c69cabc *R/CrossTable.R a7e807bc8dc63a9f5d9c680a7c10dd9c *R/ci.R 78f6edb1cb7fb3b143286f3231b447fc *R/coefFrame.R bc42206437d352433fe04c22c36c54d4 *R/est.mer.R d804883f491dbe5491131535df5720b7 *R/estimable.R 7e294fe2fcb636c91fa3bb475e617eca *R/estimable.mlm.R 19c50d94c2609ef5d8168c549812d95b *R/fast.prcomp.R 6afb0321f5f8284c7ea54b83c8a10f7b *R/fit.contrast.R 856492f7b0e2462b2379355e039353be *R/glh.test.R 20db623aa31b4edae6ae6fc45b1a9b4f *R/make.contrasts.R 1ebfe9012f37f1bdd775aa40a32dea12 *R/percentile.R 1ff7786a9ee50852e8fb4a74cd9762da *R/to.est.R a609b99c5b4ddb2b6baf97e1f635a499 *inst/ChangeLog fce721822110b9cf1e2677963fe44d88 *inst/NEWS 667645516f753372ad42643c9daf70e2 *man/CrossTable.Rd 8625eab2808cdb0186e2f9e41f0c14b2 *man/ci.Rd a9d48eaa6a14aee6fc61c2b069413956 *man/coefFrame.Rd 284be852c80ea32820665ae74d56d094 *man/estimable.Rd 3fa12153ebe28c142881ae5b1dcf5c08 *man/fast.prcomp.Rd 20c2ba2807fa182ddb6f6f54daa5ece2 *man/fit.contrast.Rd 1553aa5a3761899641049bed1aa12316 *man/glh.test.Rd bd9e1208213e02d046acb661cc3eb792 *man/make.contrasts.Rd gmodels/DESCRIPTION0000644000176000001440000000166612217322402013446 0ustar ripleyusersPackage: gmodels Version: 2.15.4.1 Date: 2012-06-27 Title: Various R programming tools for model fitting Author: Gregory R. Warnes. Includes R source code and/or documentation contributed by Ben Bolker, Thomas Lumley, and Randall C Johnson. Contributions from Randall C. Johnson are Copyright (2005) SAIC-Frederick, Inc. Funded by the Intramural Research Program, of the NIH, National Cancer Institute, Center for Cancer Research under NCI Contract NO1-CO-12400. Maintainer: Gregory R. Warnes Description: Various R programming tools for model fitting Depends: R (>= 1.9.0) Suggests: gplots, gtools, Matrix, nlme, lme4 (>= 0.999999-0) Imports: MASS, gdata License: GPL-2 URL: http://cran.r-project.org/src/contrib/PACKAGES.html http://www.sf.net/projects/r-gregmisc Packaged: 2013-09-21 13:53:36 UTC; ripley Repository: CRAN Date/Publication: 2013-09-21 15:54:10 NeedsCompilation: no gmodels/ChangeLog0000644000176000001440000004675211772724233013534 0ustar ripleyusers2012-06-28 00:41 warnes * [r1575] R/est.lmer.R, R/est.mer.R: Update est.mer() to support new S4 "mer" class. 2012-06-28 00:40 warnes * [r1574] man/ci.Rd: Make lme4 example executable. 2012-06-27 22:42 warnes * [r1573] test/lme-test.R: Add test code submitted by Ariel.Muldoon@oregonstate.edu. 2012-04-19 22:09 warnes * [r1528] inst/NEWS: Update for release 2.15.2 2012-04-19 22:07 warnes * [r1527] DESCRIPTION: Update version and date. 2012-04-19 22:06 warnes * [r1526] man/estimable.Rd: The 'Design' package has been replaced my 'rms', so update man page references. 2012-04-19 22:05 warnes * [r1525] R/ci.R, R/est.mer.R: More fixes for support of S4 'mer' class from lme4 package. 2012-04-19 21:13 warnes * [r1524] man/coefFrame.Rd: Split long line. 2012-04-19 17:50 warnes * [r1523] man/ci.Rd, man/glh.test.Rd: Changes to pass R CMD check 2011-12-14 18:17 warnes * [r1521] R/ci.R: Improve formatting of ci.mer(). 2011-12-14 18:14 warnes * [r1520] R/est.mer.R: Modify est.mer to work with recent lme4 'mer' S4 objects. 2011-01-16 22:17 warnes * [r1466] DESCRIPTION, inst/NEWS, man/ci.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Fix warnings reported by R CMD check. Update version number to 2.15.1. 2009-05-09 05:29 warnes * [r1337] test, test/lme-test.R: Add tests for lme4 'mer' objects 2009-05-09 05:04 warnes * [r1336] inst/NEWS: Update for 2.15.0 2009-05-09 05:02 warnes * [r1335] DESCRIPTION: Update description for 2.15.0 2009-05-09 05:01 warnes * [r1334] R/est.mer.R: Add support for lme4's 'mer' objects 2009-05-09 05:00 warnes * [r1333] NAMESPACE, R/ci.R, R/est.lmer.R, R/estimable.R, R/fit.contrast.R, R/to.est.R: Add support for lme4's 'mer' objects 2009-05-09 04:53 warnes * [r1332] man/glh.test.Rd: Fix .Rd syntax error 2009-05-09 04:37 warnes * [r1331] NEWS: Add softlinks for ChangeLog and NEWS to top level dir for convenience 2009-05-09 04:36 warnes * [r1330] ChangeLog, NEWS, inst, inst/NEWS: Move ChangeLog and NEWS files into inst directory 2009-05-09 04:00 warnes * [r1329] DESCRIPTION, man/ci.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Update Greg's email address 2008-04-10 14:05 warnes * [r1255] man/ci.Rd: Improve languages a bit 2008-01-02 16:56 warnes * [r1236] man/CrossTable.Rd: Update Marc's email address 2007-12-12 21:16 warnes * [r1233] DESCRIPTION: Move copyright notice for Randall's contributions from License section to Author section of the DESCRIPTION file. 2007-12-07 22:21 warnes * [r1232] DESCRIPTION, NEWS: Update DESCRIPTION and NEWS for release 2.14.1 2007-12-07 22:10 warnes * [r1231] man/estimable.Rd: Correct minor typos in man page for estimable() 2007-12-07 22:09 warnes * [r1230] R/estimable.R: Add support for lme models to estimable() 2007-12-07 22:07 warnes * [r1229] man/estimable.Rd: Replace non-ascii characters in Soren's name with (equivalent?) ascii character to avoid character encoding issues. 2007-10-22 02:24 warnes * [r1196] DESCRIPTION: Clarify GPL version 2007-07-26 00:20 warnes * [r1105] DESCRIPTION, NAMESPACE, NEWS, R/estimable.mlm.R, man/estimable.Rd: Add support for mlm to estimable(). 2007-07-26 00:10 warnes * [r1104] R/estimable.R, R/estimable.mlm.R: Add estimable method for mlm objects 2007-03-09 22:35 warnes * [r1079] R/ci.R: Remove stray character 2007-03-09 20:10 warnes * [r1078] NEWS: Update NEWS file. 2007-03-09 20:07 warnes * [r1077] DESCRIPTION: Update version number 2007-03-09 20:06 warnes * [r1076] R/ci.R: Minor code formatting changes 2007-03-09 20:06 warnes * [r1075] R/est.lmer.R, man/ci.Rd: Flip lower and upper interval in ci.lmer(). Add example to man page. 2007-03-09 19:43 warnes * [r1074] man/ci.Rd, man/estimable.Rd: Fix some old email addressses that got missed 2006-11-29 00:11 warnes * [r1029] NEWS: Update for 2.13.1 2006-11-29 00:05 warnes * [r1028] NAMESPACE: Correct declartion of S3 methods for estimable() 2006-11-29 00:05 warnes * [r1027] DESCRIPTION: Add additional suggested packages 2006-11-29 00:04 warnes * [r1026] R/estimable.R, man/estimable.Rd: - Add generic - Fix code vs. doc inconsistiencies 2006-11-28 22:38 warnes * [r1025] R/ci.R, R/estimable.R, R/fast.prcomp.R: Remove extraneous comma that causes errors in R 2.5.0 2006-11-27 20:45 warnes * [r1016] DESCRIPTION, NEWS: Update for 2.13.1 2006-11-27 20:36 warnes * [r1015] DESCRIPTION, NAMESPACE: Add missing export of methods for estimable() 2006-11-14 22:25 ggorjan * [r1012] R/ci.R, R/fast.prcomp.R, man/ci.Rd: Removed executable property 2006-08-02 22:21 warnes * [r977] man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Update my email address 2006-06-06 19:17 nj7w * [r966] man/ci.Rd, man/estimable.Rd, man/fit.contrast.Rd: Updated ci, estimable and fit.contrast as per Randall Johnson 2006-06-05 21:00 nj7w * [r965] DESCRIPTION: Additions as per Randall C Johnson 2006-06-05 20:59 nj7w * [r964] R/ci.R, R/estimable.R, R/fit.contrast.R, R/to.est.R: Additions as per Randall C Johnson 2006-06-05 20:57 nj7w * [r963] R/est.lmer.R: - New function to estimate CI's and p-values using mcmcsamp() from the Matrix package 2006-05-05 18:29 nj7w * [r959] R/CrossTable.R, man/CrossTable.Rd: Fixed an error: According to Marc Schwartz - there was an error when a matrix without dimnames(or names(dimnames)) was passed as x argument 2005-12-13 16:03 nj7w * [r808] ChangeLog: Removed ChangeLog 2005-12-13 16:02 nj7w * [r807] NEWS: Updated NEWS 2005-12-12 21:57 nj7w * [r796] DESCRIPTION: Updated version number for CRAN 2005-12-04 06:27 warnes * [r781] NEWS: Update for 2.11.0 2005-12-04 06:12 warnes * [r780] DESCRIPTION, NAMESPACE, R/ci.R, R/estimable.R, R/fit.contrast.R, R/to.est.R, man/ci.Rd, man/estimable.Rd: Integration of code changes suggested by Randall C Johnson to add support for lmer (lme version 4) objects to ci(), estimable(), and fit.contrast(). Addition of simplified coefficient specificaiton for estimable() based on a function provided by Randall C Johnson. It is now possible to do things like: estimable(reg, c("xB"=1,"xD"=-1) ) instead of: estimable(reg, c( 0, 1, 0, -1) ) which should make estimable much easier to use for large models. 2005-12-01 16:54 nj7w * [r776] man/ci.Rd, man/coefFrame.Rd, man/estimable.Rd, man/fit.contrast.Rd, man/make.contrasts.Rd: Updated Greg's email address 2005-10-27 11:21 warnes * [r709] DESCRIPTION: Update version number. Bump minor version since we added functionality. 2005-10-27 10:33 warnes * [r708] DESCRIPTION, NAMESPACE: Add ci.binom() to NAMESPACE, bump version 2005-10-26 13:39 warnes * [r707] R/ci.R, man/ci.Rd: Add ci.binom 2005-10-25 21:18 warnes * [r706] NAMESPACE: Add gdata::nobs to import list. Needed by ci() 2005-09-12 15:44 nj7w * [r671] man/fast.prcomp.Rd, man/glh.test.Rd: Updated Greg's email 2005-09-07 15:31 nj7w * [r667] man/CrossTable.Rd: Fixed man page 2005-09-06 21:34 nj7w * [r664] DESCRIPTION: Updated DESCRIPTION 2005-09-06 21:34 nj7w * [r663] NEWS: Added NEWS 2005-09-06 16:21 nj7w * [r662] DESCRIPTION: Fixed the Package name 2005-09-02 23:10 nj7w * [r655] ChangeLog: Added ChangeLog 2005-08-31 16:28 nj7w * [r644] DESCRIPTION: Added DESCRIPTION file 2005-08-31 16:27 nj7w * [r643] DESCRIPTION.in: removed DESCRIPTION.in 2005-07-11 21:35 nj7w * [r627] R/CrossTable.R, man/CrossTable.Rd: Revision based on Marc Schwartz's suggestions: 1) Added 'dnn' argument to enable specification of dimnames as per table() 2) Corrected bug in SPSS output for 1d table, where proportions were being printed and not percentages ('%' output) 2005-06-09 14:20 nj7w * [r625] R/ci.R, R/coefFrame.R, R/estimable.R, R/fast.prcomp.R, R/fit.contrast.R, R/glh.test.R, R/make.contrasts.R, man/CrossTable.Rd, man/ci.Rd, man/coefFrame.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Updating the version number, and various help files to synchronize splitting of gregmisc bundle in 4 individual components. 2005-06-09 14:13 nj7w * [r623] R/CrossTable.R: Updates by Marc Schwartz: CrossTable: # Revision 2.0 2005/04/27 # Added 'format = "d"' to all table count output # so that large integers do not print in # scientific notation 2005-05-13 18:59 nj7w * [r621] man/CrossTable.Rd: 1) Using dQuote.ascii function in read.xls as the new version of dQuote doesn't work proprly with UTF-8 locale. 2) Modified CrossTable.Rd usage in gmodels 3) Modified heatmap.2 usage in gplots. 2005-05-11 13:51 warnes * [r620] DESCRIPTION.in, NAMESPACE: Add dependency on gdata::frameApply. 2005-03-31 20:32 warnes * [r593] NAMESPACE: Add ceofFrame function to NAMESPACE 2005-03-31 19:05 warnes * [r592] man/coefFrame.Rd: coefFrame example needs to properly load ELISA data from gtools package 2005-03-31 18:31 warnes * [r588] R/CrossTable.R, man/CrossTable.Rd, man/ci.Rd, man/estimable.Rd, man/fast.prcomp.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: Ensure that each file has $Id$ header, and no $Log$ 2005-03-31 18:30 warnes * [r587] R/coefFrame.R, man/coefFrame.Rd: Add coefFrame() function contributed by Jim Rogers 2005-01-18 19:53 warnes * [r521] R/CrossTable.R: Removed Windows Line Endings 2005-01-14 21:40 nj7w * [r518] man/CrossTable.Rd: Updated the manual to reflect prop.chisq change in its R file. 2005-01-14 19:14 warnes * [r517] R/CrossTable.R: Nitin added display of the Chisquare contribution of each cell, as suggested by Greg Snow. 2005-01-12 20:50 warnes * [r515] DESCRIPTION.in: Add dependency on R 1.9.0+ to prevent poeple from installing on old versions of R which don't support namespaces. 2004-12-23 19:32 nj7w * [r507] R/CrossTable.R, man/CrossTable.Rd: Split the function print.CrossTable.vector in two parts - for SAS behaiour and SPSS behaviour. Also put the code of printing statistics in a function 'print.statistics' 2004-12-21 22:38 warnes * [r502] R/CrossTable.R: Added & extended changes made by Nitin to implement 'SPSS' format, as suggested by Dirk Enzmann . 2004-09-30 21:03 warneg * [r464] man/glh.test.Rd: Fix typos. 2004-09-27 21:01 warneg * [r461] DESCRIPTION, DESCRIPTION.in: Updated to pass R CMD check. 2004-09-03 22:44 warneg * [r450] man/fit.contrast.Rd: Add explicit package to call to quantcut in example. 2004-09-03 17:27 warneg * [r446] DESCRIPTION, NAMESPACE, R/CrossTable.R, R/ci.R, R/estimable.R, R/fast.prcomp.R, R/fit.contrast.R, R/glh.test.R, R/make.contrasts.R, man/estimable.Rd, man/fit.contrast.Rd, man/glh.test.Rd, man/make.contrasts.Rd: initial bundle checkin 2004-09-02 17:14 warneg * [r442] DESCRIPTION, DESCRIPTION.in, NAMESPACE: Initial revision 2004-05-25 02:57 warnes * [r327] R/CrossTable.R, man/CrossTable.Rd: Updates from Mark Schwartz. 2004-04-13 11:41 warnes * [r314] man/estimable.Rd: Fix latex warning: it doesn't like double subscripts. 2004-03-26 22:28 warnes * [r306] man/fast.prcomp.Rd: Reflect movement of code from 'mva' package to 'stats' in R 1.9.0. 2004-03-25 20:09 warnes * [r296] R/estimable.R, man/estimable.Rd: - Estimable was reporting sqrt(X^2) rather than X^2 in the output. - Provide latex math markup for linear algebra expressions in help text. - Other clarifications in help text 2004-03-25 18:17 warnes * [r295] R/estimable.R, man/estimable.Rd: Add enhancements to estimable() provided by S�ren H�jsgaard \email{sorenh@agrsci.dk}: I have made a modified version of the function [..] which 1) also works on geese and gee objects and 2) can test hypotheses af the forb L * beta = beta0 both as a single Wald test and row-wise for each row in L. 2003-11-17 21:40 warnes * [r221] R/fit.contrast.R: - Fix incorrect handling of glm objects by fit.contrast, as reported by Ulrich Halekoh, Phd . - Add regression test code to for this bug. 2003-08-07 03:49 warnes * [r217] R/ci.R: - Fixed incorrect denominator in standard error for mean in ci.default. 2003-04-22 17:24 warnes * [r190] R/fit.contrast.R: - the variable 'df' was used within the lme code section overwriting the argument 'df'. 2003-03-12 17:58 warnes * [r173] man/fit.contrast.Rd: - Fixed a typo in the example - Added to lme example 2003-03-07 15:48 warnes * [r168] R/fast.prcomp.R: - Minor changes to code to allow the package to be provided as an S-Plus chapter. 2003-01-30 21:53 warnes * [r160] R/fit.contrast.R, man/fit.contrast.Rd: - Renamed 'contrast.lm' to 'fit.contrast'. This new name is more descriptive and makes it easier to create and use methods for other classes, eg lme. - Enabled fit.contrast for lme object now that Doug Bates has provided the necessary support for contrasts in the nlme package. - New contrast.lm function which generates a 'depreciated' warning and calls fit.contrast - Updated help text to match changes. 2003-01-30 21:41 warnes * [r158] R/CrossTable.R, man/CrossTable.Rd: - Removed argument 'correct' and now print separate corrected values for 2 x 2 tables. - Added arguments 'prop.r', 'prop.c' and 'prop.t' to toggle printing of row, col and table percentages. Default is TRUE. - Added argument 'fisher' to toggle fisher exact test. Default is FALSE. - Added McNemar test to statistics and argument 'mcnemar' to toggle test. Default is FALSE. - Added code to generate an invisible return list containing table counts, proportions and the results of the appropriate statistical tests. 2003-01-30 14:58 warnes * [r157] R/make.contrasts.R: - Added explicit check to ensure that the number of specified contrasts is less than or equal to the ncol - 1. Previously, this failed with an obtuse error message when the contrast matrix had row names, and silently dropped contrasts over ncol-1. 2002-11-04 14:13 warnes * [r142] R/CrossTable.R: - Moved fisher.test() to after table is printed, so that table is still printed in the event that fisher.test() results in errors. 2002-10-29 23:06 warnes * [r138] R/fast.prcomp.R, man/fast.prcomp.Rd: - Fixes to fast.svd to make it actually work. - Updates to man page to fix mistmatches between code and docs and to fix warnings. 2002-10-29 23:00 warnes * [r137] R/make.contrasts.R, man/make.contrasts.Rd: - Moved make.contrasts to a separate file. - Enhanced make contrasts to better label contrast matrix, to give how.many a default value, and to coerce vectors into row matrixes. - Added help page for make.contrasts. - Added link from contrasts.lm seealso to make.contrasts. 2002-10-29 19:29 warnes * [r136] R/fast.prcomp.R, man/fast.prcomp.Rd: Initial checkin for fast.prcomp() and fast.svd(). 2002-09-26 12:11 warnes * [r127] man/glh.test.Rd: - Added note and example code to illustrate how to properly compute contrasts for the first factor in the model. 2002-09-24 19:12 warnes * [r124] R/glh.test.R: - Fixed a typo. 2002-09-23 14:27 warnes * [r119] man/CrossTable.Rd, man/glh.test.Rd: - Fixed syntax errors in barplot2.Rd and CrossTable.Rd - Fixed incorrect translation of 'F' (distribution) to 'FALSE' in glh.test.Rd 2002-09-23 13:59 warnes * [r117] R/ci.R, man/estimable.Rd, man/glh.test.Rd: - Modified all files to include CVS Id and Log tags. 2002-09-23 13:38 warnes * [r116] R/CrossTable.R, man/CrossTable.Rd: - Added CrossTable() and barplot2() code and docs contributed by Marc Schwartz. - Permit combinations() to be used when r>n provided repeat.allowed=TRUE - Bumped up version number 2002-08-01 19:37 warnes * [r114] R/ci.R, man/ci.Rd, man/estimable.Rd, man/glh.test.Rd: - Corrected documentation mismatch for ci, ci.default. - Replaced all occurences of '_' for assignment with '<-'. - Replaced all occurences of 'T' or 'F' for 'TRUE' and 'FALSE' with the spelled out version. - Updaded version number and date. 2002-04-09 00:51 warneg * [r109] R/ci.R, R/estimable.R, R/glh.test.R, man/glh.test.Rd: Checkin for version 0.5.3 2002-03-26 21:22 warneg * [r104] R/ci.R, R/glh.test.R, man/ci.Rd, man/glh.test.Rd: - Changed methods to include '...' to match the generic. - Updated for version 0.5.1 2002-03-26 15:30 warneg * [r99] man/glh.test.Rd: Removed incorrect link to 'contrast' from seealso. 2002-02-20 20:09 warneg * [r81] man/ci.Rd, man/estimable.Rd, man/glh.test.Rd: Minor changes, typo and formatting fixes. 2002-01-17 23:51 warneg * [r70] man/estimable.Rd: - Fixed errror in last example by adding 'conf.int' parameter to 'estimable' call. 2002-01-17 23:42 warneg * [r69] R/glh.test.R: - Fixed typo in code that resulted in an syntax error. 2002-01-10 17:35 warneg * [r68] R/glh.test.R: - print.glh.test() was using cat() to printing the call. This didn't work and generated an error. 2001-12-19 20:06 warneg * [r66] man/glh.test.Rd: - Fixed display of formulae. - Added description of return value 2001-12-19 20:05 warneg * [r65] R/glh.test.R: - Removed extra element of return object. 2001-12-18 22:14 warneg * [r64] man/estimable.Rd: - Updated documentation to reflect change of parameters from 'alpha' to 'conf.int', including the new optional status of the confidence intervals. 2001-12-18 22:12 warneg * [r63] R/estimable.R: - Modified to make confidence intervals optional. Changed 'alpha' parameter giving significance level to 'conf.int' giving confidence level. 2001-12-18 21:36 warneg * [r62] man/glh.test.Rd: - Added summary.glh.test to alias, usage, and example sections. 2001-12-18 21:34 warneg * [r61] R/glh.test.R: - Modified to work correctly when obj is of class 'aov' by specifying summary.lm instead of summary. This ensures that the summary object has the fields we need. - Moved detailed reporting of results from 'print' to 'summary' function and added a simpler report to 'print' 2001-12-18 21:27 warneg * [r60] R/estimable.R: - Modified to work correctly when obj is of class 'aov' by specifying summary.lm instead of summary. This ensures that the summary object has the fields we need. 2001-12-18 00:45 warneg * [r59] R/glh.test.R, man/glh.test.Rd: Initial checkin. 2001-12-17 18:59 warneg * [r56] man/estimable.Rd: - Fixed spelling errors. 2001-12-17 18:52 warneg * [r55] man/estimable.Rd: - Fixed the link to contrasts.lm. - Rephrased title/description to be more clear. 2001-12-10 19:35 warneg * [r49] man/estimable.Rd: Renamed 'contrsts.coeff.Rd' to 'estimable.Rd' corresponding to function rename. 2001-12-10 19:26 warneg * [r48] R/estimable.R: renamed from contrast.coeff.R to estimable.R (incorrectly via contrast.lm.R) 2001-12-07 19:50 warneg * [r37] man/ci.Rd: - Added text noting that lme is now supported. 2001-12-07 19:19 warneg * [r36] R/ci.R: - Fixed typo: DF column was being filled in with p-value. 2001-12-07 18:49 warneg * [r35] R/ci.R: - Added ci.lme method to handle lme objects. 2001-10-16 23:15 warneg * [r27] man/ci.Rd: Fixed unbalanced brace. 2001-08-25 05:52 warneg * [r12] man/ci.Rd: - Added CVS header. - Added my email address. 2001-05-30 13:23 warneg * [r2] ., R, R/ci.R, man, man/ci.Rd: Initial revision gmodels/man/0000755000176000001440000000000012217322233012504 5ustar ripleyusersgmodels/man/ci.Rd0000644000176000001440000000473412217322233013376 0ustar ripleyusers% $Id: ci.Rd 1574 2012-06-28 00:40:29Z warnes $ % \name{ci} \alias{ci} \alias{ci.default} \alias{ci.binom} \alias{ci.lm} \alias{ci.lme} \alias{ci.mer} \title{Compute Confidence Intervals} \description{ Compute and display confidence intervals for model estimates. Methods are provided for the mean of a numeric vector \code{ci.default}, the probability of a binomial vector \code{ci.binom}, and for \code{lm}, \code{lme}, and \code{mer} objects are provided. } \usage{ ci(x, confidence = 0.95, alpha = 1 - confidence,...) \method{ci}{default}(x, confidence = 0.95, alpha = 1 - confidence, na.rm = FALSE, ...) \method{ci}{binom}(x, confidence = 0.95, alpha = 1 - confidence,...) \method{ci}{lm}(x, confidence = 0.95, alpha = 1 - confidence,...) \method{ci}{lme}(x, confidence = 0.95, alpha = 1 - confidence,...) \method{ci}{mer}(x, confidence = 0.95, alpha = 1 - confidence, sim.mer=TRUE, n.sim=10000, ...) } \arguments{ \item{x}{ object from which to compute confidence intervals. } \item{confidence}{ confidence level. Defaults to 0.95. } \item{alpha}{type one error rate. Defaults to 1.0-\code{confidence} } \item{na.rm}{boolean indicating whether missing values should be removed. Defaults to \code{FALSE}.} \item{\dots}{Arguments for methods} \item{sim.mer}{Logical value. If TRUE confidence intervals will be estimated using \code{mcmcsamp}. This option only takes effect for mer objects.} \item{n.sim}{Number of samples to take in \code{mcmcsamp}.} } %\details{ % ~~ If necessary, more details than the __description__ above ~~ %} \value{ vector or matrix with one row per model parameter and elements/columns \code{Estimate}, \code{CI lower}, \code{CI upper}, \code{Std. Error}, \code{DF} (for lme objects only), and \code{p-value}. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[stats]{confint}}, \code{\link[stats]{lm}}, \code{\link[stats]{summary.lm}} } \examples{ # mean and confidence interval ci( rnorm(10) ) # binomial proportion and exact confidence interval b <- rbinom( prob=0.75, size=1, n=20 ) ci.binom(b) # direct call class(b) <- 'binom' ci(b) # indirect call # confidence intervals for regression parameteres data(state) reg <- lm(Area ~ Population, data=as.data.frame(state.x77)) ci(reg) # mer example -- that means lme4 < 1.0 #if(require(lme4)) { #fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy) #print(ci(fm2)) #} } \keyword{ regression } gmodels/man/make.contrasts.Rd0000644000176000001440000000724311514667154015752 0ustar ripleyusers% $Id: make.contrasts.Rd 1466 2011-01-16 22:17:17Z warnes $ % \name{make.contrasts} \alias{make.contrasts} \title{Construct a User-Specified Contrast Matrix} \description{ Construct a user-specified contrast matrix. } \usage{ make.contrasts(contr, how.many = ncol(contr)) } \arguments{ \item{contr}{ vector or matrix specifying contrasts (one per row).} \item{how.many}{ dimensions of the desired contrast matrix. This must equal the number of levels of the target factor variable.} } \details{ This function converts human-readable contrasts into the form that R requires for computation. Specifying a contrast row of the form \code{c(1,0,0,-1)} creates a contrast that will compare the mean of the first group with the mean of the fourth group. } \value{ \code{make.contrasts} returns a matrix with dimensions (\code{how.many}, \code{how.many}) containing the specified contrasts augmented (if necessary) with orthogonal "filler" contrasts. This matrix can then be used as the argument to \code{\link{contrasts}} or to the \code{contrasts} argument of model functions (eg, \code{\link{lm}}). } \author{ Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link{lm}}, \code{\link{contrasts}}, \code{\link{contr.treatment}}, \code{\link{contr.poly}}, Computation and testing of General Linear Hypothesis: \code{\link{glh.test}}, Computation and testing of estimable functions of model coefficients: \code{\link{estimable}}, Estimate and Test Contrasts for a previously fit linear model: \code{\link{fit.contrast}} } \examples{ set.seed(4684) y <- rnorm(100) x.true <- rnorm(100, mean=y, sd=0.25) x <- factor(cut(x.true,c(-4,-1.5,0,1.5,4))) reg <- lm(y ~ x) summary(reg) # Mirror default treatment contrasts test <- make.contrasts(rbind( c(-1,1,0,0), c(-1,0,1,0), c(-1,0,0,1) )) lm( y ~ x, contrasts=list(x = test )) # Specify some more complicated contrasts # - mean of 1st group vs mean of 4th group # - mean of 1st and 2nd groups vs mean of 3rd and 4th groups # - mean of 1st group vs mean of 2nd, 3rd and 4th groups cmat <- rbind( "1 vs 4" =c(-1, 0, 0, 1), "1+2 vs 3+4"=c(-1/2,-1/2, 1/2, 1/2), "1 vs 2+3+4"=c(-3/3, 1/3, 1/3, 1/3)) summary(lm( y ~ x, contrasts=list(x=make.contrasts(cmat) ))) # or contrasts(x) <- make.contrasts(cmat) summary(lm( y ~ x ) ) # or use contrasts.lm reg <- lm(y ~ x) fit.contrast( reg, "x", cmat ) # compare with values computed directly using group means gm <- sapply(split(y,x),mean) gm %*% t(cmat) # # Example for Analysis of Variance # set.seed(03215) Genotype <- sample(c("WT","KO"), 1000, replace=TRUE) Time <- factor(sample(1:3, 1000, replace=TRUE)) data <- data.frame(y, Genotype, Time) y <- rnorm(1000) data <- data.frame(y, Genotype, as.factor(Time)) # Compute Contrasts & obtain 95\% confidence intervals model <- aov( y ~ Genotype + Time + Genotype:Time, data=data ) fit.contrast( model, "Genotype", rbind("KO vs WT"=c(-1,1) ), conf=0.95 ) fit.contrast( model, "Time", rbind("1 vs 2"=c(-1,1,0), "2 vs 3"=c(0,-1,1) ), conf=0.95 ) cm.G <- rbind("KO vs WT"=c(-1,1) ) cm.T <- rbind("1 vs 2"=c(-1,1,0), "2 vs 3"=c(0,-1,1) ) # Compute contrasts and show SSQ decompositions model <- model <- aov( y ~ Genotype + Time + Genotype:Time, data=data, contrasts=list(Genotype=make.contrasts(cm.G), Time=make.contrasts(cm.T) ) ) summary(model, split=list( Genotype=list( "KO vs WT"=1 ), Time = list( "1 vs 2" = 1, "2 vs 3" = 2 ) ) ) } \keyword{ models } \keyword{ regression } gmodels/man/estimable.Rd0000644000176000001440000001401611744106167014754 0ustar ripleyusers% $Id: estimable.Rd 1526 2012-04-19 22:06:49Z warnes $ % \name{estimable} \alias{estimable} \alias{estimable.default} \alias{estimable.mer} \alias{estimable.mlm} %\alias{.wald} %\alias{.to.est} \title{Contrasts and estimable linear functions of model coefficients} \description{ Compute and test contrasts and other estimable linear functions of model coefficients for for lm, glm, lme, mer, and geese objects } \usage{ estimable(obj, cm, beta0, conf.int=NULL, show.beta0, ...) \method{estimable}{default} (obj, cm, beta0, conf.int=NULL, show.beta0, joint.test=FALSE, ...) \method{estimable}{mer}(obj, cm, beta0, conf.int=NULL, show.beta0, sim.mer=TRUE, n.sim=1000, ...) \method{estimable}{mlm}(obj, cm, beta0, conf.int=NULL, show.beta0, ...) %.wald(obj, cm,beta0=rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm)))) %.to.est(obj, params) } \arguments{ \item{obj}{Regression (lm, glm, lme, mer, mlm) object. } \item{cm}{Vector, List, or Matrix specifying estimable linear functions or contrasts. See below for details.} \item{beta0}{Vector of null hypothesis values} \item{conf.int}{Confidence level. If provided, confidence intervals will be computed.} \item{joint.test}{Logical value. If TRUE a 'joint' Wald test for the hypothesis \eqn{L \beta=\beta_0}{L \%*\% beta=beta0} is performed. Otherwise 'row-wise' tests are performed, i.e. \eqn{(L \beta)_i=\beta_{0i}}{(L \%*\% beta)[i]=beta0[i]} } \item{show.beta0}{Logical value. If TRUE a column for beta0 will be included in the output table. Defaults to TRUE when beta0 is specified, FALSE otherwise.} \item{sim.mer}{Logical value. If TRUE p-values and confidence intervals will be estimated using \code{mcmcsamp}. } \item{n.sim}{Number of MCMC samples to take in \code{mcmcsamp}. } \item{...}{ignored} } \details{ \code{estimable} computes an estimate, test statitic, significance test, and (optional) confidence interval for each linear functions of the model coefficients specified by \code{cm}. The estimable function(s) may be specified via a vector, list, or matrix. If \code{cm} is a vector, it should contained named elements each of which gives the coefficient to be applied to the corresponding parameter. These coefficients will be used to construct the contrast matrix, with unspecified model parameters assigned zero coefficients. If \code{cm} is a list, it should contain one or more coefficient vectors, which will be used to construct rows of the contrast matrix. If \code{cm} is a matrix, column names must match (a subset of) the model parameters, and each row should contain the corresponding coefficient to be applied. Model parameters which are not present in the set of column names of \code{cm} will be set to zero. The estimates and their variances are obtained by applying the contrast matrix (generated from) \code{cm} to the model estimates variance-covariance matrix. Degrees of freedom are obtained from the appropriate model terms. The user is responsible for ensuring that the specified linear functions are meaningful. For computing contrasts among levels of a single factor, \code{fit.contrast} may be more convenient. For computing contrasts between two specific combinations of model parameters, the \code{contrast} function in Frank Harrell's 'rms' library (formerly 'Design') may be more convenient. %The \code{.wald} function is called internally by \code{estimable} and %is not intended for direct use. } \note{ The estimated fixed effect parameters of \code{lme} objects may have different degrees of freedom. If a specified contrast includes nonzero coefficients for parameters with differing degrees of freedom, the smallest number of degrees of freedom is used and a warning message is issued. } \value{ Returns a matrix with one row per linear function. Columns contain the beta0 value (optional, see \code{show.beta0} above), estimated coefficients, standard errors, t values, degrees of freedom, two-sided p-values, and the lower and upper endpoints of the 1-alpha confidence intervals. } \author{ BXC (Bendix Carstensen) \email{bxc\@novonordisk.com}, Gregory R. Warnes \email{greg@warnes.net}, Soren Hojsgaard \email{sorenh@agrsci.dk}, and Randall C Johnson \email{rjohnson@ncifcrf.gov} } \seealso{ \code{\link{fit.contrast}}, \code{\link[stats]{lm}}, \code{\link[nlme]{lme}}, \code{\link[stats]{contrasts}}, \code{\link[rms]{contrast.rms}}, } \examples{ # setup example data y <- rnorm(100) x <- cut(rnorm(100, mean=y, sd=0.25),c(-4,-1.5,0,1.5,4)) levels(x) <- c("A","B","C","D") x2 <- rnorm(100, mean=y, sd=0.5) # simple contrast and confidence interval reg <- lm(y ~ x) estimable(reg, c( 0, 1, 0, -1) ) # full coefficient vector estimable(reg, c("xB"=1,"xD"=-1) ) # just the nonzero terms # Fit a spline with a single knot at 0.5 and plot the *pointwise* # confidence intervals library(gplots) pm <- pmax(x2-0.5, 0) # knot at 0.5 reg2 <- lm(y ~ x + x2 + pm ) range <- seq(-2, 2, , 50) tmp <- estimable(reg2, cm=cbind( '(Intercept)'=1, 'xC'=1, 'x2'=range, 'pm'=pmax(range-0.5, 0) ), conf.int=0.95) plotCI(x=range, y=tmp[, 1], li=tmp[, 6], ui=tmp[, 7]) # Fit both linear and quasi-Poisson models to iris data, then compute # joint confidence intervals on contrasts for the Species and # Sepal.Width by Species interaction terms. data(iris) lm1 <- lm (Sepal.Length ~ Sepal.Width + Species + Sepal.Width:Species, data=iris) glm1 <- glm(Sepal.Length ~ Sepal.Width + Species + Sepal.Width:Species, data=iris, family=quasipoisson("identity")) cm <- rbind( 'Setosa vs. Versicolor' = c(0, 0, 1, 0, 1, 0), 'Setosa vs. Virginica' = c(0, 0, 0, 1, 0, 1), 'Versicolor vs. Virginica'= c(0, 0, 1,-1, 1,-1) ) estimable(lm1, cm) estimable(glm1, cm) } \keyword{ models } \keyword{ regression } gmodels/man/glh.test.Rd0000644000176000001440000000633111744050132014526 0ustar ripleyusers% $Id: glh.test.Rd 1523 2012-04-19 17:50:20Z warnes $ % \name{glh.test} \alias{glh.test} \alias{print.glh.test} \alias{summary.glh.test} \title{ Test a General Linear Hypothesis for a Regression Model } \description{ Test, print, or summarize a general linear hypothesis for a regression model } \usage{ glh.test(reg, cm, d=rep(0, nrow(cm)) ) \method{print}{glh.test}(x, digits=4,...) \method{summary}{glh.test}(object, digits=4,...) } \arguments{ \item{reg}{ Regression model } \item{cm}{ matrix . Each row specifies a linear combination of the coefficients } \item{d}{ vector specifying the null hypothis values for each linear combination} \item{x, object}{glh.test object} \item{digits}{number of digits} \item{...}{ optional parameters (ignored)} } \details{ Test the general linear hypothesis \eqn{ C \hat{beta} = d }{C \%*\% \hat{beta} == d } for the regression model \code{reg}. The test statistic is obtained from the formula: \deqn{f = \frac{(C \hat{\beta} - d)' ( C (X'X)^{-1} C' ) (C \hat{\beta} - d) / r }{ SSE / (n-p) } }{ F = (C Beta-hat - d)' ( C (X'X)^-1 C' ) (C Beta-hat - d) / r / ( SSE / (n-p) ) } Under the null hypothesis, f will follow a F-distribution with r and n-p degrees of freedom. } \note{ When using treatment contrasts (the default) the first level of the factors are subsumed into the intercept term. The estimated model coefficients are then contrasts versus the first level. This should be taken into account when forming contrast matrixes, particularly when computing contrasts that include 'baseline' level of factors. See the comparison with \code{fit.contrast} in the examples below. } \value{ Object of class \code{c("glh.test","htest")} with elements: \item{call }{Function call that created the object} \item{statistic }{F statistic} \item{parameter}{ vector containing the numerator (r) and denominator (n-p) degrees of freedom } \item{p.value}{ p-value} \item{estimate}{ computed estimate for each row of \code{cm} } \item{null.value}{ d } \item{method}{ description of the method } \item{data.name}{ name of the model given for \code{reg} } \item{matrix}{ matrix specifying the general linear hypotheis (\code{cm}) } } \references{ R.H. Myers, Classical and Modern Regression with Applications, 2nd Ed, 1990, p. 105} \author{Gregory R. Warnes \email{greg@warnes.net} } \seealso{\code{\link{fit.contrast}}, \code{\link{estimable}}, \code{\link{contrasts}} } \examples{ # fit a simple model y <- rnorm(100) x <- cut(rnorm(100, mean=y, sd=0.25),c(-4,-1.5,0,1.5,4)) reg <- lm(y ~ x) summary(reg) # test both group 1 = group 2 and group 3 = group 4 # *Note the 0 in the column for the intercept term* C <- rbind( c(0,-1,0,0), c(0,0,-1,1) ) ret <- glh.test(reg, C) ret # same as 'print(ret) ' summary(ret) # To compute a contrast between the first and second level of the factor # 'x' using 'fit.contrast' gives: fit.contrast( reg, x,c(1,-1,0,0) ) # To test this same contrast using 'glh.test', use a contrast matrix # with a zero coefficient for the intercept term. See the Note section, # above, for an explanation. C <- rbind( c(0,-1,0,0) ) glh.test( reg, C ) } \keyword{ models } \keyword{ regression } gmodels/man/fit.contrast.Rd0000644000176000001440000001275111514667154015434 0ustar ripleyusers% $Id: fit.contrast.Rd 1466 2011-01-16 22:17:17Z warnes $ % \name{fit.contrast} \alias{fit.contrast} \alias{fit.contrast.lm} \alias{fit.contrast.lme} \alias{fit.contrast.mer} \title{Compute and test arbitrary contrasts for regression objects} \description{ Compute and test arbitrary contrasts for regression objects. } \usage{ fit.contrast(model, varname, coeff, ... ) \method{fit.contrast}{lm}(model, varname, coeff, showall=FALSE, conf.int=NULL, df=FALSE, ...) \method{fit.contrast}{lme}(model, varname, coeff, showall=FALSE, conf.int=NULL, df=FALSE, ...) \method{fit.contrast}{mer}(model, varname, coeff, showall=FALSE, conf.int=NULL, sim.mer = TRUE, n.sim = 1000, ...) } \arguments{ \item{model}{regression (lm,glm,aov,lme) object for which the contrast(s) will be computed.} \item{varname}{variable name} \item{coeff}{vector or matrix specifying contrasts (one per row).} \item{showall}{return all regression coefficients. If \code{TRUE}, all model cofficients will be returned. If \code{FALSE} (the default), only the coefficients corresponding to the specified contrast will be returned.} \item{conf.int}{numeric value on (0,1) or NULL. If a numeric value is specified, confidence intervals with nominal coverage probability \code{conf.int} will be computed. If \code{NULL}, confidence intervals will not be computed.} \item{df}{boolean indicating whether to return a column containing the degrees of freedom.} \item{\dots}{optional arguments provided by methods.} \item{sim.mer}{Logical value. If TRUE p-values and confidence intervals will be estimated using \code{mcmcsamp}. This option only takes effect for mer objects.} \item{n.sim}{Number of samples to use in \code{mcmcsamp}.} } \details{ Computes the specified contrast(s) by re-fitting the model with the appropriate arguments. A contrast of the form \code{c(1,0,0,-1)} would compare the mean of the first group with the mean of the fourth group. } \value{ Returns a matrix containing estimated coefficients, standard errors, t values, two-sided p-values. If \code{df} is TRUE, an additional column containing the degrees of freedom is included. If \code{conf.int} is specified lower and upper confidence limits are also returned.} \references{Venables & Ripley, Section 6.2} \author{ Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link{lm}}, \code{\link{contrasts}}, \code{\link{contr.treatment}}, \code{\link{contr.poly}}, Computation and testing of General Linear Hypothesis: \code{\link{glh.test}}, Computation and testing of estimable functions of model coefficients: \code{\link{estimable}}, \code{\link{make.contrasts}} } \examples{ y <- rnorm(100) x <- cut(rnorm(100, mean=y, sd=0.25),c(-4,-1.5,0,1.5,4)) reg <- lm(y ~ x) summary(reg) # look at the group means gm <- sapply(split(y,x),mean) gm # mean of 1st group vs mean of 4th group fit.contrast(reg, x, c( 1, 0, 0, -1) ) # estimate should be equal to: gm[1] - gm[4] # mean of 1st and 2nd groups vs mean of 3rd and 4th groups fit.contrast(reg, x, c( -1/2, -1/2, 1/2, 1/2) ) # estimate should be equal to: sum(-1/2*gm[1], -1/2*gm[2], 1/2*gm[3], 1/2*gm[4]) # mean of 1st group vs mean of 2nd, 3rd and 4th groups fit.contrast(reg, x, c( -3/3, 1/3, 1/3, 1/3) ) # estimate should be equal to: sum(-3/3*gm[1], 1/3*gm[2], 1/3*gm[3], 1/3*gm[4]) # all at once cmat <- rbind( "1 vs 4" =c(-1, 0, 0, 1), "1+2 vs 3+4"=c(-1/2,-1/2, 1/2, 1/2), "1 vs 2+3+4"=c(-3/3, 1/3, 1/3, 1/3)) fit.contrast(reg,x,cmat) # x2 <- rnorm(100,mean=y,sd=0.5) reg2 <- lm(y ~ x + x2 ) fit.contrast(reg2,x,c(-1,0,0,1)) # # Example for Analysis of Variance # set.seed(03215) Genotype <- sample(c("WT","KO"), 1000, replace=TRUE) Time <- factor(sample(1:3, 1000, replace=TRUE)) y <- rnorm(1000) data <- data.frame(y, Genotype, Time) # Compute Contrasts & obtain 95\% confidence intervals model <- aov( y ~ Genotype + Time + Genotype:Time, data=data ) fit.contrast( model, "Genotype", rbind("KO vs WT"=c(-1,1) ), conf=0.95 ) fit.contrast( model, "Time", rbind("1 vs 2"=c(-1,1,0), "2 vs 3"=c(0,-1,1) ), conf=0.95 ) cm.G <- rbind("KO vs WT"=c(-1,1) ) cm.T <- rbind("1 vs 2"=c(-1,1,0), "2 vs 3"=c(0,-1,1) ) # Compute contrasts and show SSQ decompositions model <- aov( y ~ Genotype + Time + Genotype:Time, data=data, contrasts=list(Genotype=make.contrasts(cm.G), Time=make.contrasts(cm.T) ) ) summary(model, split=list( Genotype=list( "KO vs WT"=1 ), Time = list( "1 vs 2" = 1, "2 vs 3" = 2 ) ) ) # example for lme library(nlme) data(Orthodont) fm1 <- lme(distance ~ Sex, data = Orthodont,random=~1|Subject) # Contrast for sex. This example is equivalent to standard treatment # contrast. # fit.contrast(fm1, "Sex", c(-1,1), conf.int=0.95 ) # # and identical results can be obtained using lme built-in 'intervals' # intervals(fm1) # Cut age into quantile groups & compute some contrasts Orthodont$AgeGroup <- gtools::quantcut(Orthodont$age) fm2 <- lme(distance ~ Sex + AgeGroup, data = Orthodont,random=~1|Subject) # fit.contrast(fm2, "AgeGroup", rbind("Linear"=c(-2,-1,1,2), "U-Shaped"=c(-1,1,1,-1), "Change-Point at 11"=c(-1,-1,1,1)), conf.int=0.95) } \keyword{ models } \keyword{ regression } gmodels/man/fast.prcomp.Rd0000644000176000001440000000717111514667154015252 0ustar ripleyusers% $Id: fast.prcomp.Rd 1466 2011-01-16 22:17:17Z warnes $ % \name{fast.prcomp} \alias{fast.prcomp} \alias{fast.svd} \title{Efficient computation of principal components and singular value decompositions.} \description{ The standard \code{\link[stats]{prcomp}} and \code{\link{svd}} function are very inefficient for wide matrixes. \code{fast.prcomp} and \code{fast.svd} are modified versions which are efficient even for matrixes that are very wide. } \usage{ fast.prcomp(x, retx = TRUE, center = TRUE, scale. = FALSE, tol = NULL) fast.svd( x, nu = min(n, p), nv = min(n, p), ...) } \arguments{ \item{x}{data matrix} \item{retx, center, scale., tol}{ See documetation for \code{\link[stats]{prcomp}} } \item{nu, nv, ...}{ See documetation for \code{\link{svd}} } } \details{ The current implementation of the function \code{\link{svd}} in S-Plus and R is much slower when operating on a matrix with a large number of columns than on the transpose of this matrix, which has a large number of rows. As a consequence, \code{\link[stats]{prcomp}}, which uses \code{\link{svd}}, is also very slow when applied to matrixes with a large number of rows. For R, the simple solution is to use \code{\link{La.svd}} instead of \code{\link{svd}}. A suitable patch to \code{\link[stats]{prcomp}} has been submitted. In the mean time, the function \code{fast.prcomp} has been provided as a short-term work-around. For S-Plus the solution is to replace the standard \code{\link{svd}} with a version that checks the dimensions of the matrix, and performs the computation on the transposed the matrix if it is wider than tall. For R: \describe{ \item{\code{fast.prcomp}}{is a modified versiom of \code{\link[stats]{prcomp}} that calls \code{\link{La.svd}} instead of \code{\link{svd}} } \item{\code{fast.svd}}{is simply a wrapper around \code{\link{La.svd}}. } } For S-Plus: \describe{ \item{\code{fast.prcomp}}{is a modified versiom of \code{\link{prcomp}} that calls \code{fast.svd} instead of \code{\link{svd}} } \item{\code{fast.svd}}{checks the dimensions of the matrix. When it is wider than tall, it transposes the input matrix and calls \code{\link{svd}}. It then swaps \code{u} and \code{v} and returns the result. Otherwise, it just calls \code{\link{svd}} and returns the results unchanged. } } } \value{ See the documetation for \code{\link[stats]{prcomp}} or \code{\link{svd}} . } \author{Modifications by Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[stats]{prcomp}}, \code{\link{svd}}, \code{\link{La.svd}} } \examples{ # create test matrix set.seed(4943546) nr <- 50 nc <- 2000 x <- matrix( rnorm( nr*nc), nrow=nr, ncol=nc ) tx <- t(x) # SVD directly on matrix is SLOW: system.time( val.x <- svd(x)$u ) # SVD on t(matrix) is FAST: system.time( val.tx <- svd(tx)$v ) # and the results are equivalent: max( abs(val.x) - abs(val.tx) ) # Time gap dissapears using fast.svd: system.time( val.x <- fast.svd(x)$u ) system.time( val.tx <- fast.svd(tx)$v ) max( abs(val.x) - abs(val.tx) ) library(stats) # prcomp directly on matrix is SLOW: system.time( pr.x <- prcomp(x) ) # prcomp.fast is much faster system.time( fast.pr.x <- fast.prcomp(x) ) # and the results are equivalent max( pr.x$sdev - fast.pr.x$sdev ) max( abs(pr.x$rotation[,1:49]) - abs(fast.pr.x$rotation[,1:49]) ) max( abs(pr.x$x) - abs(fast.pr.x$x) ) # (except for the last and least significant component): max( abs(pr.x$rotation[,50]) - abs(fast.pr.x$rotation[,50]) ) } \keyword{multivariate} \keyword{algebra} \keyword{array} gmodels/man/coefFrame.Rd0000644000176000001440000000541111744077765014710 0ustar ripleyusers% $Id: coefFrame.Rd 1524 2012-04-19 21:13:28Z warnes $ % \name{coefFrame} \alias{coefFrame} \title{Return model parameters in a data frame} \description{Fits a model to each subgroup defined by \code{by}, then returns a data frame with one row for each fit and one column for each parameter. } \usage{ coefFrame(mod, data, by = NULL, fit.on = TRUE, fitfun, keep.unused.levels = TRUE, byvar.sep = "\001", ...) } \arguments{ \item{mod}{a model formula, to be passed to by \code{fitfun}.} \item{data}{a data frame, row subsets of which will be used as the \code{data} argument to \code{fitfun}.} \item{by}{names of columns in \code{x} that will be used to define the subgroups.} \item{fit.on}{a logical vector indicating which rows of \code{x} are to be used to fit the model (like the \code{subset} argument in a lot of other functions). Can be given in terms of variables in \code{x}} \item{fitfun}{a model fitting function (e.g. lm, nls). More specifically, a function that expects at least a formula object (as the first argument) and a data.frame object (passed as an argument named \code{data}) and returns a model object for which a \code{coef} method has been defined (e.g. coef.lm, coef.nls) to extract fit values of model parameters.} \item{keep.unused.levels}{Include rows in output for all unique values of \code{by}, even those which were excluded by \code{fit.on}. The default value \code{TRUE} should be left alone if you are going to go on to pass the result to \code{backFit}.} \item{byvar.sep}{passed to frameApply, used to form the subsets of the data.} \item{...}{other arguments to pass to \code{fitfun}.} } \value{a data frame with a row for each unique row of \code{x[by]}, and column for each model paramter, as well as columns specified in \code{by}. } \examples{ # load example data library(gtools) data(ELISA) # Coefficients for four parameter logistic fits: coefFrame(log(Signal) ~ SSfpl(log(Concentration), A, B, xmid, scal), data = ELISA, fitfun = nls, by = c("PlateDay", "Read"), fit.on = Description == "Standard" & Concentration != 0) # Coefficients for linear fits: coefFrame(log(Signal) ~ log(Concentration), data = ELISA, fitfun = lm, by = c("PlateDay", "Read"), fit.on = Description == "Standard" & Concentration != 0 ) # Example passing arguments to fitfun, and example of # error handling during model fitting: ELISA$Signal[1] <- NA coefFrame(log(Signal) ~ log(Concentration), data = ELISA, fitfun = lm, na.action = na.fail, by = c("PlateDay", "Read"), fit.on = Description == "Standard" & Concentration != 0 ) } \author{Jim Rogers \email{james.a.rogers@pfizer.com}} \keyword{models} gmodels/man/CrossTable.Rd0000644000176000001440000001364211472132125015043 0ustar ripleyusers%% Revision 2.2 2006/05/02 %% Fix a bug when a matrix is passed as the 'x' argument %% Reported by Prof. Albert Sorribas same day %% Fix involved creating default values for RowData and ColData %% when there are no dimnames for the matrix %% Revision 2.1 2005/06/26 %% Added 'dnn' argument to enable specification of dimnames %% names as per table() %% Revision 2.0 2005/04/27 %% Added attributions to Nitin Jain and %% and Dirk Enzmann for SPSS format \name{CrossTable} \alias{CrossTable} \title{Cross Tabulation with Tests for Factor Independence} \description{ An implementation of a cross-tabulation function with output similar to S-Plus crosstabs() and SAS Proc Freq (or SPSS format) with Chi-square, Fisher and McNemar tests of the independence of all table factors. } \usage{ CrossTable(x, y, digits=3, max.width = 5, expected=FALSE, prop.r=TRUE, prop.c=TRUE, prop.t=TRUE, prop.chisq=TRUE, chisq = FALSE, fisher=FALSE, mcnemar=FALSE, resid=FALSE, sresid=FALSE, asresid=FALSE, missing.include=FALSE, format=c("SAS","SPSS"), dnn = NULL, ...) } \arguments{ \item{x}{A vector or a matrix. If y is specified, x must be a vector} \item{y}{A vector in a matrix or a dataframe} \item{digits}{Number of digits after the decimal point for cell proportions} \item{max.width}{In the case of a 1 x n table, the default will be to print the output horizontally. If the number of columns exceeds max.width, the table will be wrapped for each successive increment of max.width columns. If you want a single column vertical table, set max.width to 1} \item{expected}{If \code{TRUE}, chisq will be set to \code{TRUE} and expected cell counts from the \eqn{\chi^2}{Chi-Square} will be included} \item{prop.r}{If \code{TRUE}, row proportions will be included} \item{prop.c}{If \code{TRUE}, column proportions will be included} \item{prop.t}{If \code{TRUE}, table proportions will be included} \item{prop.chisq}{If \code{TRUE}, chi-square contribution of each cell will be included} \item{chisq}{If \code{TRUE}, the results of a chi-square test will be included} \item{fisher}{If \code{TRUE}, the results of a Fisher Exact test will be included} \item{mcnemar}{If \code{TRUE}, the results of a McNemar test will be included} \item{resid}{If \code{TRUE}, residual (Pearson) will be included} \item{sresid}{If \code{TRUE}, standardized residual will be included} \item{asresid}{If \code{TRUE}, adjusted standardized residual will be included} \item{missing.include}{If \code{TRUE}, then remove any unused factor levels} \item{format}{Either SAS (default) or SPSS, depending on the type of output desired.} \item{dnn}{the names to be given to the dimensions in the result (the dimnames names).} \item{\dots}{optional arguments} } \details{ A summary table will be generated with cell row, column and table proportions and marginal totals and proportions. Expected cell counts can be printed if desired (if 'chisq = TRUE'). In the case of a 2 x 2 table, both corrected and uncorrected values will be included for appropriate tests. In the case of tabulating a single vector, cell counts and table proportions will be printed. Note: If 'x' is a vector and 'y' is not specified, no statistical tests will be performed, even if any are set to \code{TRUE}. } \value{ A list with multiple components including key table data and statistical test results, where performed. t: An n by m matrix containing table cell counts prop.col: An n by m matrix containing cell column proportions prop.row: An n by m matrix containing cell row proportions prop.tbl: An n by m matrix containing cell table proportions chisq: Results from the Chi-Square test. A list with class 'htest'. See ?chisq.test for details chisq.corr: Results from the corrected Chi-Square test. A list with class 'htest'. See ?chisq.test for details. ONLY included in the case of a 2 x 2 table. fisher.ts: Results from the two-sided Fisher Exact test. A list with class 'htest'. See ?fisher.test for details. ONLY included if 'fisher' = TRUE. fisher.lt: Results from the Fisher Exact test with HA = "less". A list with class 'htest'. See ?fisher.test for details. ONLY included if 'fisher' = TRUE and in the case of a 2 x 2 table. fisher.gt: Results from the Fisher Exact test with HA = "greater". A list with class 'htest'. See ?fisher.test for details. ONLY included if 'fisher' = TRUE and in the case of a 2 x 2 table. mcnemar: Results from the McNemar test. A list with class 'htest'. See ?mcnemar.test for details. ONLY included if 'mcnemar' = TRUE. mcnemar.corr: Results from the corrected McNemar test. A list with class 'htest'. See ?mcnemar.test for details. ONLY included if 'mcnemar' = TRUE and in the case of a 2 x 2 table. resid/sresid/asresid: Pearson Residuals (from chi-square tests). } \author{Marc Schwartz \email{marc_schwartz@comcast.net}. Original version posted to r-devel on Jul 27, 2002. SPSS format modifications added by Nitin Jain based upon code provided by Dirk Enzmann \email{dirk.enzmann@jura.uni-hamburg.de}} \seealso{\code{\link{xtabs}}, \code{\link{table}}, \code{\link{prop.table}}} \examples{ # Simple cross tabulation of education versus prior induced abortions # using infertility data data(infert, package = "datasets") CrossTable(infert$education, infert$induced, expected = TRUE) CrossTable(infert$education, infert$induced, expected = TRUE, format="SAS") CrossTable(infert$education, infert$induced, expected = TRUE, format="SPSS") CrossTable(warpbreaks$wool, warpbreaks$tension, dnn = c("Wool", "Tension")) } \keyword{category} \keyword{univar}