r-gregmisc-users — Discussion list for R gregmisc packages (gplot, gmodels, gdata, gtools)

[R-gregmisc-users] SF.net SVN: r-gregmisc: [984] trunk/gdata/inst/doc/Rnews.sty

[<wa...@us...>]

Revision: 984
          http://svn.sourceforge.net/r-gregmisc/?rev=984&view=rev
Author:   warnes
Date:     2006-09-18 13:33:30 -0700 (Mon, 18 Sep 2006)

Log Message:
-----------
Update Rnews.sty to the latest version

Modified Paths:
--------------
    trunk/gdata/inst/doc/Rnews.sty

Modified: trunk/gdata/inst/doc/Rnews.sty
===================================================================
--- trunk/gdata/inst/doc/Rnews.sty	2006-09-18 20:24:18 UTC (rev 983)
+++ trunk/gdata/inst/doc/Rnews.sty	2006-09-18 20:33:30 UTC (rev 984)
@@ -20,13 +20,13 @@
 %% original source files, as listed above, are part of the
 %% same distribution. (The sources need not necessarily be
 %% in the same archive or directory.)
-\def\fileversion{v0.3.1}
+\def\fileversion{v0.3.6}
 \def\filename{Rnews}
-\def\filedate{2001/09/04}
-\def\docdate {2001/09/04}
+\def\filedate{2002/06/02}
+\def\docdate {2001/10/31}
 %%
 %% Package `Rnews' to use with LaTeX2e
-%% Copyright (C) 2001 by the R Core Development Team
+%% Copyright (C) 2001--2002 by the R Core Development Team
 %% Please report errors to KH or FL
 %%
 %% -*- LaTeX -*-
@@ -53,31 +53,37 @@
 \newenvironment{article}{%
   \author{}\title{}\subtitle{}}{\end{multicols}}
 \renewcommand{\maketitle}{
-  \chapter{\Rnews@title}
-  \refstepcounter{chapter}
-  \begin{multicols}{2}
-    \ifx\empty\Rnews@subtitle\else\par\addvspace{\baselineskip}
-    \noindent\textbf{\Rnews@subtitle}\fi
-    \ifx\empty\Rnews@author\else\par\addvspace{\baselineskip}
-    \noindent\textit{\Rnews@author}\fi}
-\renewcommand\chapter{\secdef\@chapter\@schapter}
+  \begin{multicols}{2}[\chapter{\Rnews@title}\refstepcounter{chapter}][3cm]
+    \ifx\empty\Rnews@subtitle\else\noindent\textbf{\Rnews@subtitle}
+    \par\nobreak\addvspace{\baselineskip}\fi
+    \ifx\empty\Rnews@author\else\noindent\textit{\Rnews@author}
+    \par\nobreak\addvspace{\baselineskip}\fi
+    \@afterindentfalse\@nobreaktrue\@afterheading}
+\renewcommand\chapter{\secdef\Rnews@chapter\@schapter}
+\providecommand{\nohyphens}{%
+  \hyphenpenalty=10000\exhyphenpenalty=10000\relax}
+\newcommand{\Rnews@chapter}{%
+  \renewcommand{\@seccntformat}[1]{}%
+  \@startsection{chapter}{0}{0mm}{%
+    -2\baselineskip \@plus -\baselineskip \@minus -.2ex}{\p@}{%
+    \normalfont\Huge\bfseries\raggedright}}
 \renewcommand*\l@chapter{\@dottedtocline{0}{0pt}{1em}}
-\def\@makechapterhead#1{%
-  \addvspace{2\baselineskip}%
-  {\parindent \z@ \raggedright \normalfont
-    \ifnum \c@secnumdepth >\m@ne
-        \huge\bfseries \@chapapp\space \thechapter
-        \par\nobreak
-        \vskip 20\p@
-    \fi
-    \interlinepenalty\@M
-    \Huge \bfseries #1\par\nobreak}}
 \def\@schapter#1{\section*#1}
 \renewenvironment{figure}[1][]{%
   \def\@captype{figure}
-  \begin{minipage}{0.9\columnwidth}}{
+  \noindent
+  \begin{minipage}{\columnwidth}}{%
   \end{minipage}\par\addvspace{\baselineskip}}
 \renewcommand{\theequation}{\@arabic\c@equation}
+\def\equation{%
+  \let\refstepcounter\H@refstepcounter
+  \H@equation
+  \def\newname{\arabic{chapter}.\theequation}%
+  \let\theHequation\newname%
+  \hyper@makecurrent{equation}%
+  \Hy@raisedlink{\hyper@anchorstart{\@currentHref}}%
+  \let\refstepcounter\new@refstepcounter}%
+\def\endequation{\Hy@raisedlink{\hyper@anchorend}\H@endequation}
 \renewcommand{\thefigure}{\@arabic\c@figure}
 \renewcommand{\thetable}{\@arabic\c@table}
 \renewcommand{\contentsname}{Contents of this issue:}
@@ -145,12 +151,22 @@
       \hspace*{-\Rnews@len}\fbox{\usebox{\Rnews@box}}
     \end{center}
   \end{figure*}}
-\newenvironment{boxedverbatim}{%
-  \begin{lrbox}{\Rnews@box}
-    \begin{smallverbatim}}{%
-    \end{smallverbatim}
-  \end{lrbox}
-  \hspace*{-\fboxsep}\fbox{\usebox{\Rnews@box}}}
+\RequirePackage{verbatim}
+\def\boxedverbatim{%
+  \def\verbatim@processline{%
+    {\setbox0=\hbox{\the\verbatim@line}%
+    \hsize=\wd0 \the\verbatim@line\par}}%
+  \@minipagetrue
+  \@tempswatrue
+  \setbox0=\vbox
+  \bgroup\small\verbatim
+}
+\def\endboxedverbatim{%
+  \endverbatim
+  \unskip\setbox0=\lastbox
+  \egroup
+  \fbox{\box0}
+}
 \pagestyle{fancy}
 } % \ifthenelse{\boolean{Rnews@driver}}
 \newcommand\code{\bgroup\@codex}
@@ -172,6 +188,7 @@
 \newenvironment{example}{\begin{alltt}}{\end{alltt}}
 \newenvironment{smallexample}{\begin{alltt}\small}{\end{alltt}}
 \newenvironment{display}{\list{}{}\item\relax}{\endlist}
+\newenvironment{smallverbatim}{\small\verbatim}{\endverbatim}
 \providecommand{\operatorname}[1]{%
   \mathop{\operator@font#1}\nolimits}
 \renewcommand{\P}{%


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [983] trunk/gdata

[<wa...@us...>]

Revision: 983
          http://svn.sourceforge.net/r-gregmisc/?rev=983&view=rev
Author:   warnes
Date:     2006-09-18 13:24:18 -0700 (Mon, 18 Sep 2006)

Log Message:
-----------
Integrate fixes for trim() from Gregor and myself.

Modified Paths:
--------------
    trunk/gdata/R/trim.R
    trunk/gdata/inst/unitTests/Makefile
    trunk/gdata/inst/unitTests/runit.trim.R
    trunk/gdata/man/trim.Rd
    trunk/gdata/tests/doRUnit.R

Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R	2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/R/trim.R	2006-09-18 20:24:18 UTC (rev 983)
@@ -1,29 +1,30 @@
 # $Id$
 
-trim <- function(s)
+trim <- function(s, recode.factor=TRUE)
   UseMethod("trim", s)
 
-trim.default <- function(s)
+trim.default <- function(s, recode.factor=TRUE)
   s
 
-trim.character <- function(s)
+trim.character <- function(s, recode.factor=TRUE)
 {
   s <- sub(pattern="^ +", replacement="", x=s)
   s <- sub(pattern=" +$", replacement="", x=s)
   s
 }
 
-trim.factor <- function(s)
+trim.factor <- function(s, recode.factor=TRUE)
 {
   levels(s) <- trim(levels(s))
+  if(recode.factor) s <- reorder.factor(s, sort=sort)
   s
 }
 
-trim.list <- function(s)
-  lapply(s, trim)
+trim.list <- function(s, recode.factor=TRUE)
+  lapply(s, trim, recode.factor=recode.factor)
 
-trim.data.frame <- function(s)
+trim.data.frame <- function(s, recode.factor=TRUE)
 {
-  s[] <- trim.list(s)
+  s[] <- trim.list(s, recode.factor=recode.factor)
   s
 }

Modified: trunk/gdata/inst/unitTests/Makefile
===================================================================
--- trunk/gdata/inst/unitTests/Makefile	2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/inst/unitTests/Makefile	2006-09-18 20:24:18 UTC (rev 983)
@@ -1,14 +1,15 @@
 PKG=gdata
 TOP=../..
 SUITE=doRUnit.R
+R=R
 
 all: inst test
 
 inst: # Install package
 	cd ${TOP}/..;\
-	R CMD INSTALL ${PKG}
+	${R} CMD INSTALL ${PKG}
 
 test: # Run unit tests
 	export RCMDCHECK=FALSE;\
 	cd ${TOP}/tests;\
-	R --vanilla --slave < ${SUITE}
+	${R} --vanilla --slave < ${SUITE}

Modified: trunk/gdata/inst/unitTests/runit.trim.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.trim.R	2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/inst/unitTests/runit.trim.R	2006-09-18 20:24:18 UTC (rev 983)
@@ -20,8 +20,8 @@
   sTrim <- "    this is an example string    "
   sTrimR <- "this is an example string"
 
-  fTrim <- c(sTrim, sTrim, " A", " B ", "  C ", "D ")
-  fTrimR <- c(sTrimR, sTrimR, "A", "B", "C", "D")
+  fTrim <- factor(c(sTrim, sTrim, " A", " B ", "  C ", "D "))
+  fTrimR <- factor(c(sTrimR, sTrimR, "A", "B", "C", "D"))
 
   lTrim <- list(s=rep(sTrim, times=6), f=fTrim, i=1:6)
   lTrimR <- list(s=rep(sTrimR, times=6), f=fTrimR, i=1:6)
@@ -31,6 +31,10 @@
 
   checkIdentical(trim(sTrim), sTrimR)
   checkIdentical(trim(fTrim), fTrimR)
+  checkIdentical(
+                 levels(trim(fTrim, recode.factor=FALSE)),
+                 c("this is an example string", "C", "A", "B", "D")
+                 )
   checkIdentical(trim(lTrim), lTrimR)
   checkIdentical(trim(dfTrim), dfTrimR)
 }

Modified: trunk/gdata/man/trim.Rd
===================================================================
--- trunk/gdata/man/trim.Rd	2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/man/trim.Rd	2006-09-18 20:24:18 UTC (rev 983)
@@ -2,13 +2,15 @@
 \alias{trim}
 \title{Remove leading and trailing spaces from character strings}
 \description{
- Remove leading and traling spaces from character strings
+ Remove leading and trailing spaces from character strings and other
+ related objects.
 }
 \usage{
-trim(s)
+trim(s, recode.factor=TRUE)
 }
 \arguments{
   \item{s}{object to be processed}
+  \item{recode.factor}{Should levels of a factor be recoded, see below}
 }
 
 \details{
@@ -18,24 +20,40 @@
 factor \code{s} trims \code{\link{levels}}. There are also methods for
 \code{list} and \code{data.frame}.
 
+Trimming character strings can change the sort order in some
+locales.  For factors, this can affect the coding of levels.  By
+default, factor levels are recoded to match the trimmed sort order, but
+this can be disabled by setting \code{recode.factor=FALSE}.
+
 }
 \value{
-  \code{s} with all leading and traling spaces removed in its elements.
+  \code{s} with all leading and trailing spaces removed in its elements.
 }
-\author{ Gregory R. Warnes \email{wa...@bs...} }
-\seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} }
+\author{ Gregory R. Warnes \email{wa...@bs...}  with
+  contributions by Gregor Gorjanc}
+\seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} as well as
+  argument \code{strip.white} in \code{\link{read.table}}}
 \examples{
 s <- "    this is an example string    "
 trim(s)
 
-f <- c(s, s, " A", " B ", "  C ", "D ")
+f <- factor(c(s, s, " A", " B ", "  C ", "D "))
+levels(f)
+
 trim(f)
+levels(trim(f))
 
+trim(f,recode.factor=FALSE)
+levels(trim(f,recode.factor=FALSE))
+
+
 l <- list(s=rep(s, times=6), f=f, i=1:6)
 trim(l)
 
 df <- as.data.frame(l)
 trim(df)
 
+
 }
+\keyword{manip}
 \keyword{character}

Modified: trunk/gdata/tests/doRUnit.R
===================================================================
--- trunk/gdata/tests/doRUnit.R	2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/tests/doRUnit.R	2006-09-18 20:24:18 UTC (rev 983)
@@ -1,8 +1,8 @@
-## doRUnit.R
+### doRUnit.R
 ###------------------------------------------------------------------------
-## What: Run RUnit tests
-## $Id$
-## Time-stamp: <2006-08-09 23:27:21 ggorjan>
+### What: Run RUnit tests
+### $Id$
+### Time-stamp: <2006-09-18 13:14:34 ggorjan>
 ###------------------------------------------------------------------------
 
 if(require("RUnit", quietly=TRUE)) {
@@ -46,4 +46,4 @@
 }
 
 ###------------------------------------------------------------------------
-## doRUnit.R ends here
+### doRUnit.R ends here


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [982] trunk/gdata/inst/unitTests

[<wa...@us...>]

Revision: 982
          http://svn.sourceforge.net/r-gregmisc/?rev=982&view=rev
Author:   warnes
Date:     2006-09-18 12:32:26 -0700 (Mon, 18 Sep 2006)

Log Message:
-----------
Remove unneeded files.

Removed Paths:
-------------
    trunk/gdata/inst/unitTests/report.html
    trunk/gdata/inst/unitTests/report.txt

Deleted: trunk/gdata/inst/unitTests/report.html
===================================================================
--- trunk/gdata/inst/unitTests/report.html	2006-09-13 19:46:56 UTC (rev 981)
+++ trunk/gdata/inst/unitTests/report.html	2006-09-18 19:32:26 UTC (rev 982)
@@ -1,92 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
-"http://www.w3.org/TR/html4/transitional.dtd">
-<html><head><title>RUNIT TEST PROTOCOL--Wed Sep 13 14:16:43 2006</title>
-</head>
-<body><h1 TRUE>RUNIT TEST PROTOCOL--Wed Sep 13 14:16:43 2006</h1>
-<p>Number of test functions: 10</p>
-<p>Number of errors: 0</p>
-<p style=color:red>Number of failures: 1</p>
-<hr>
-<h3 TRUE>1 Test suite</h3>
-<table border="1" width="60%" >
-<tr><th width="30%">Name</th>
-<th width="30%">Test functions</th>
-<th width="20%">Errors</th>
-<th width="20%">Failures</th>
-</tr>
-<tr><td><a href="#gdata unit testing">gdata unit testing</a></td>
-<td>10</td>
-<td>0</td>
-<td bgcolor="red">1</td>
-</tr>
-</table>
-<hr>
-<h3 TRUE>Failures</h3>
-<table border="1" width="100%" >
-<tr><th width="30%">Test suite : test function</th>
-<th width="70%">message</th>
-</tr>
-<tr><td><a href="#gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.trim.R_test.trim">gdata unit testing : test.trim</a></td>
-<td>Error in checkIdentical(trim(dfTrim), dfTrimR) : 
-	FALSE 
-</td>
-</tr>
-</table>
-<hr>
-<h3 TRUE>Details</h3>
-<p><a name="gdata unit testing"><h5 TRUE>Test Suite: gdata unit testing</h5>
-</a>Test function regexp: ^test.+<br/>Test file regexp: ^runit.+\.[rR]$<br/>Involved directory:<br/>/Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests<br/><ul><li><a href="/Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.drop.levels.R">Test file: runit.drop.levels.R</a><ul><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.drop.levels.R_test.drop.levels">test.drop.levels: ... OK (0.17 seconds)<br/></a></li></ul></li><li><a href="/Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.mapLevels.R">Test file: runit.mapLevels.R</a><ul><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.mapLevels.R_test.cLevelsMap">test.cLevelsMap: ... OK (0.09 seconds)<br/></a></li><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.mapLevels.R_test.checkLevelsMap">test.checkLevelsMap: ... OK (0.02 seconds)<br/></a></li><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.mapLevels.R_test.mapLevels">test.mapLevels: ... OK (0.05 seconds)<br/></a></li><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.mapLevels.R_test.mapLevels<-">test.mapLevels<-: ... OK (0.15 seconds)<br/></a></li><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.mapLevels.R_test.uniqueLevelsMap">test.uniqueLevelsMap: ... OK (0 seconds)<br/></a></li></ul></li><li><a href="/Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.trim.R">Test file: runit.trim.R</a><ul><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.trim.R_test.trim"><u style=color:red>test.trim: FAILURE !! (check number 4)  </u></a>Error in checkIdentical(trim(dfTrim), dfTrimR) : 
-	FALSE 
-<br/></li></ul></li><li><a href="/Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.unknown.R">Test file: runit.unknown.R</a><ul><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.unknown.R_test.NAToUnknown">test.NAToUnknown: ... OK (0.36 seconds)<br/></a></li><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.unknown.R_test.isUnknown">test.isUnknown: ... OK (0.02 seconds)<br/></a></li><li><a name="gdata unit testing__Users_warnes_src_r-gregmisc_gdata_tests_.._inst_unitTests_runit.unknown.R_test.unknownToNA">test.unknownToNA: ... OK (0.05 seconds)<br/></a></li></ul></li></ul><hr>
-<table border="0" width="80%" >
-<tr><th>Name</th>
-<th>Value</th>
-</tr>
-<tr><td>platform</td>
-<td>i386-apple-darwin8.6.1</td>
-</tr>
-<tr><td>arch</td>
-<td>i386</td>
-</tr>
-<tr><td>os</td>
-<td>darwin8.6.1</td>
-</tr>
-<tr><td>system</td>
-<td>i386, darwin8.6.1</td>
-</tr>
-<tr><td>status</td>
-<td></td>
-</tr>
-<tr><td>major</td>
-<td>2</td>
-</tr>
-<tr><td>minor</td>
-<td>3.1</td>
-</tr>
-<tr><td>year</td>
-<td>2006</td>
-</tr>
-<tr><td>month</td>
-<td>06</td>
-</tr>
-<tr><td>day</td>
-<td>01</td>
-</tr>
-<tr><td>svn rev</td>
-<td>38247</td>
-</tr>
-<tr><td>language</td>
-<td>R</td>
-</tr>
-<tr><td>version.string</td>
-<td>Version 2.3.1 (2006-06-01)</td>
-</tr>
-<tr><td>host</td>
-<td>GregWarnesComputer-2.local</td>
-</tr>
-<tr><td>gcc</td>
-<td>g++-4.0 -arch i386</td>
-</tr>
-</table>
-</body>
-</html>

Deleted: trunk/gdata/inst/unitTests/report.txt
===================================================================
--- trunk/gdata/inst/unitTests/report.txt	2006-09-13 19:46:56 UTC (rev 981)
+++ trunk/gdata/inst/unitTests/report.txt	2006-09-18 19:32:26 UTC (rev 982)
@@ -1,41 +0,0 @@
-RUNIT TEST PROTOCOL -- Wed Sep 13 14:16:43 2006 
-*********************************************** 
-Number of test functions: 10 
-Number of errors: 0 
-Number of failures: 1 
-
- 
-1 Test Suite : 
-gdata unit testing - 10 test functions, 0 errors, 1 failure
-FAILURE in test.trim: Error in checkIdentical(trim(dfTrim), dfTrimR) : 
-	FALSE 
-
-
-
-Details 
-*************************** 
-Test Suite: gdata unit testing 
-Test function regexp: ^test.+ 
-Test file regexp: ^runit.+\.[rR]$ 
-Involved directory: 
-/Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests 
---------------------------- 
-Test file: /Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.drop.levels.R 
-test.drop.levels: ... OK (0.17 seconds)
---------------------------- 
-Test file: /Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.mapLevels.R 
-test.cLevelsMap: ... OK (0.09 seconds)
-test.checkLevelsMap: ... OK (0.02 seconds)
-test.mapLevels: ... OK (0.05 seconds)
-test.mapLevels<-: ... OK (0.15 seconds)
-test.uniqueLevelsMap: ... OK (0 seconds)
---------------------------- 
-Test file: /Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.trim.R 
-test.trim: FAILURE !! (check number 4)
-Error in checkIdentical(trim(dfTrim), dfTrimR) : 
-	FALSE 
---------------------------- 
-Test file: /Users/warnes/src/r-gregmisc/gdata/tests/../inst/unitTests/runit.unknown.R 
-test.NAToUnknown: ... OK (0.36 seconds)
-test.isUnknown: ... OK (0.02 seconds)
-test.unknownToNA: ... OK (0.05 seconds)


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [980] trunk/gdata

[<wa...@us...>]

Revision: 980
          http://svn.sourceforge.net/r-gregmisc/?rev=980&view=rev
Author:   warnes
Date:     2006-09-13 11:15:55 -0700 (Wed, 13 Sep 2006)

Log Message:
-----------
More fixes from Gregor Gorjanc

Modified Paths:
--------------
    trunk/gdata/NAMESPACE
    trunk/gdata/R/drop.levels.R
    trunk/gdata/R/mapLevels.R
    trunk/gdata/R/trim.R

Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/NAMESPACE	2006-09-13 18:15:55 UTC (rev 980)
@@ -32,8 +32,13 @@
        as.listLevelsMap,
        is.levelsMap,
        is.listLevelsMap,
-       sort.levelsMap, ## remove in R 2.4
-       "mapLevels<-"
+       sort.levelsMap, ## FIXME remove in R 2.4
+       "mapLevels<-",
+
+       ## unknown stuff
+       isUnknown,
+       unknownToNA,
+       NAToUnknown
 )
 
 importFrom(stats, reorder, na.omit)
@@ -70,8 +75,23 @@
 S3method(c, listLevelsMap)
 
 S3method(unique, levelsMap)
-## S3method(sort, levelsMap) ## uncomment in R 2.4
+## S3method(sort, levelsMap) ## FIXME uncomment in R 2.4
 
 S3method("mapLevels<-", default)
 S3method("mapLevels<-", list)
 S3method("mapLevels<-", data.frame)
+
+S3method(isUnknown, default)
+S3method(isUnknown, POSIXlt)
+S3method(isUnknown, list)
+S3method(isUnknown, data.frame)
+
+S3method(unknownToNA, default)
+S3method(unknownToNA, factor)
+S3method(unknownToNA, list)
+S3method(unknownToNA, data.frame)
+
+S3method(NAToUnknown, default)
+S3method(NAToUnknown, factor)
+S3method(NAToUnknown, list)
+S3method(NAToUnknown, data.frame)

Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R	2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/R/drop.levels.R	2006-09-13 18:15:55 UTC (rev 980)
@@ -3,22 +3,22 @@
   UseMethod("drop.levels")
 
 drop.levels.default <- function(x, reorder=TRUE, ...)
-  return(x)
+  x
 
 drop.levels.factor <- function(x, reorder=TRUE, ...)
 {
   x <- factor(x)
   if(reorder) x <- reorder(x, ...)
-  return(x)
+  x
 }
 
 drop.levels.list <- function(x, reorder=TRUE, ...)
 {
-  return(lapply(x, drop.levels, reorder=reorder, ...))
+  lapply(x, drop.levels, reorder=reorder, ...)
 }
 
 drop.levels.data.frame <- function(x, reorder=TRUE, ...)
 {
   x[] <- drop.levels.list(x, reorder=reorder, ...)
-  return(x)
+  x
 }

Modified: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R	2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/R/mapLevels.R	2006-09-13 18:15:55 UTC (rev 980)
@@ -2,7 +2,7 @@
 ###------------------------------------------------------------------------
 ### What: Mapping levels
 ### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
-### Time-stamp: <2006-08-31 02:24:45 ggorjan>
+### Time-stamp: <2006-09-10 03:54:56 ggorjan>
 ###------------------------------------------------------------------------
 
 ### {{{ mapLevels
@@ -25,7 +25,7 @@
 mapLevels.character <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
                                 combine=FALSE, ...)
 {
-  return(mapLevels.factor(x=x, codes=codes, sort=sort, drop=drop, ...))
+  mapLevels.factor(x=x, codes=codes, sort=sort, drop=drop, ...)
 }
 
 ## Could coerce character to factor and then use factor method, but that
@@ -57,7 +57,7 @@
     map[1:nlevs] <- levs
   }
   class(map) <- "levelsMap"
-  return(map)
+  map
 }
 
 mapLevels.list <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
@@ -72,14 +72,13 @@
       stop(sprintf("can not combine integer %s", dQuote("levelsMaps")))
     }
   }
-  return(map)
+  map
 }
 
 mapLevels.data.frame <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
                                  combine=FALSE, ...)
 {
-  return(mapLevels.list(x, codes=codes, sort=sort, drop=drop,
-                        combine=combine, ...))
+  mapLevels.list(x, codes=codes, sort=sort, drop=drop, combine=combine, ...)
 }
 
 ### }}}
@@ -122,7 +121,7 @@
   class(x) <- "list"
   x <- x[i]
   class(x) <- classX
-  return(x)
+  x
 }
 
 "[.listLevelsMap" <- function(x, i)
@@ -131,7 +130,7 @@
   class(x) <- "list"
   x <- x[i]
   class(x) <- classX
-  return(x)
+  x
 }
 
 ### }}}
@@ -162,7 +161,7 @@
   if(check)
     gdata:::.checkLevelsMap(x, method="raw")
   class(x) <- "levelsMap"
-  return(unique(x, ...))
+  unique(x, ...)
 }
 
 as.listLevelsMap <- function(x, check=TRUE)
@@ -170,7 +169,7 @@
   if(check)
     gdata:::.checkListLevelsMap(x, method="raw")
   class(x) <- "listLevelsMap"
-  return(x)
+  x
 }
 
 ### }}}
@@ -215,7 +214,7 @@
 {
   x <- list(...)
   class(x) <- "listLevelsMap"
-  return(c(x, sort=sort, recursive=TRUE))
+  c(x, sort=sort, recursive=TRUE)
 }
 
 c.listLevelsMap <- function(..., sort=TRUE, recursive=FALSE)
@@ -235,7 +234,7 @@
     if(sort) x <- sort.levelsMap(x)
     x <- unique(x)
   }
-  return(x)
+  x
 }
 
 ### }}}
@@ -243,7 +242,7 @@
 ###------------------------------------------------------------------------
 
 sort.levelsMap <- function(x, decreasing=FALSE, na.last=TRUE, ...)
-  return(x[order(names(x), na.last=na.last, decreasing=decreasing)])
+  x[order(names(x), na.last=na.last, decreasing=decreasing)]
 
 ### }}}
 ### {{{ unique
@@ -277,7 +276,7 @@
       x <- x[!test]
     }
   }
-  return(x)
+  x
 }
 
 ### }}}
@@ -317,8 +316,7 @@
       stop(sprintf("can not apply character %s to %s",
                    dQuote("levelsMap"), dQuote("integer")))
   }
-
-  return(x)
+  x
 }
 
 "mapLevels<-.list" <- function(x, value)
@@ -339,13 +337,13 @@
   }
   x <- mapply(FUN="mapLevels<-", x=x, value=value, SIMPLIFY=FALSE)
   if(isNamed) names(x) <- namesX
-  return(x)
+  x
 }
 
 "mapLevels<-.data.frame" <- function(x, value)
 {
   x[] <- "mapLevels<-.list"(x, value)
-  return(x)
+  x
 }
 
 ### }}}

Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R	2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/R/trim.R	2006-09-13 18:15:55 UTC (rev 980)
@@ -4,26 +4,26 @@
   UseMethod("trim", s)
 
 trim.default <- function(s)
-  return(s)
+  s
 
 trim.character <- function(s)
 {
   s <- sub(pattern="^ +", replacement="", x=s)
   s <- sub(pattern=" +$", replacement="", x=s)
-  return(s)
+  s
 }
 
 trim.factor <- function(s)
 {
   levels(s) <- trim(levels(s))
-  return(s)
+  s
 }
 
 trim.list <- function(s)
-  return(lapply(s, trim))
+  lapply(s, trim)
 
 trim.data.frame <- function(s)
 {
   s[] <- trim.list(s)
-  return(s)
+  s
 }


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [979] trunk/gdata

[<wa...@us...>]

Revision: 979
          http://svn.sourceforge.net/r-gregmisc/?rev=979&view=rev
Author:   warnes
Date:     2006-09-13 07:55:37 -0700 (Wed, 13 Sep 2006)

Log Message:
-----------
Add mapLevels functions from Gregor Gorjanc, along with associated unit tests.

Modified Paths:
--------------
    trunk/gdata/DESCRIPTION
    trunk/gdata/NAMESPACE

Added Paths:
-----------
    trunk/gdata/R/mapLevels.R
    trunk/gdata/man/mapLevels.Rd

Removed Paths:
-------------
    trunk/gdata/R/combineLevels.R
    trunk/gdata/R/mapFactor.R
    trunk/gdata/man/combineLevels.Rd
    trunk/gdata/man/mapFactor.Rd

Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION	2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/DESCRIPTION	2006-09-13 14:55:37 UTC (rev 979)
@@ -3,7 +3,7 @@
 Description: Various R programming tools for data manipulation
 Depends: R (>= 1.9.0)
 Imports: gtools
-Version: 2.2.0
+Version: 2.3.0
 Author: Gregory R. Warnes. Includes R source code and/or documentation
         contributed by Ben Bolker, Gregor Gorjanc, and Thomas Lumley
 Maintainer: Gregory Warnes <gre...@ur...>

Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/NAMESPACE	2006-09-13 14:55:37 UTC (rev 979)
@@ -3,7 +3,6 @@
        Args,
        aggregate.table,
        combine,
-       combineLevels,
        ConvertMedUnits,
        drop.levels,
        elem,
@@ -15,7 +14,6 @@
        ll,
        lowerTriangle,
        "lowerTriangle<-",
-       mapFactor,
        matchcols,
        nobs,
        read.xls,
@@ -26,7 +24,16 @@
        trim,
        unmatrix,
        upperTriangle,
-       "upperTriangle<-"
+       "upperTriangle<-",
+
+       ## mapLevels stuff
+       mapLevels,
+       as.levelsMap,
+       as.listLevelsMap,
+       is.levelsMap,
+       is.listLevelsMap,
+       sort.levelsMap, ## remove in R 2.4
+       "mapLevels<-"
 )
 
 importFrom(stats, reorder, na.omit)
@@ -46,3 +53,25 @@
 S3method(drop.levels, factor)
 S3method(drop.levels, list)
 S3method(drop.levels, data.frame)
+
+S3method(mapLevels, default)
+S3method(mapLevels, character)
+S3method(mapLevels, factor)
+S3method(mapLevels, list)
+S3method(mapLevels, data.frame)
+
+S3method(print, levelsMap)
+S3method(print, listLevelsMap)
+
+S3method("[", levelsMap)
+S3method("[", listLevelsMap)
+
+S3method(c, levelsMap)
+S3method(c, listLevelsMap)
+
+S3method(unique, levelsMap)
+## S3method(sort, levelsMap) ## uncomment in R 2.4
+
+S3method("mapLevels<-", default)
+S3method("mapLevels<-", list)
+S3method("mapLevels<-", data.frame)

Deleted: trunk/gdata/R/combineLevels.R
===================================================================
--- trunk/gdata/R/combineLevels.R	2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/R/combineLevels.R	2006-09-13 14:55:37 UTC (rev 979)
@@ -1,26 +0,0 @@
-## combineLevels.R
-###------------------------------------------------------------------------
-## What: Joint levels of given factors
-## $Id: combineLevels.R,v 1.1 2006/04/08 01:58:36 ggorjan Exp $
-## Time-stamp: <2006-04-08 03:57:53 ggorjan>
-###------------------------------------------------------------------------
-
-combineLevels <- function(x, apply=TRUE, drop=FALSE)
-{
-  if (!is.factor(x)) {
-    if (sum(!(c("data.frame", "list") %in% class(x))) == 2)
-      stop(paste(sQuote("x"), "must be a", dQuote("data.frame"), "or a", dQuote("list")))
-    if (any(!(unlist((lapply(x, is.factor))))))
-      stop(paste("only", dQuote("factors"), "are supported"))
-    if (drop) x <- lapply(x, factor)
-    levs <- sort(unique(unlist(lapply(x, levels))))
-    if (!apply) return(levs)
-    return(lapply(x, "levels<-", mapFactor(levs, codes=FALSE)))
-  }
-  if (drop) x <- factor(x)
-  if (!apply) return(levels(x))
-  return(x)
-}
-
-###------------------------------------------------------------------------
-## combineLevels.R ends here

Deleted: trunk/gdata/R/mapFactor.R
===================================================================
--- trunk/gdata/R/mapFactor.R	2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/R/mapFactor.R	2006-09-13 14:55:37 UTC (rev 979)
@@ -1,38 +0,0 @@
-## mapFactor.R
-###------------------------------------------------------------------------
-## What: Get a map of levels in a factor
-## $Id: mapFactor.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
-## Time-stamp: <2006-04-06 01:35:30 ggorjan>
-###------------------------------------------------------------------------
-
-mapFactor <- function(x, codes=TRUE, sort=TRUE, drop=FALSE, ...)
-{
-  ## --- Check ---
-  msg <- "x must be a factor or character"
-  if (!is.factor(x)) {
-    if (!is.character(x)) stop(msg)
-  }
-
-  ## --- Create a map ---
-  if (is.factor(x)) { # factor
-    if (drop) x <- factor(x)
-    nlevs <- nlevels(x)
-    levs <- levels(x)
-    if (sort) levs <- sort(levs, ...)
-  } else {            # character
-    levs <- unique(x)
-    if (sort) levs <- sort(levs, ...)
-    nlevs <- length(levs)
-  }
-  tmp <- vector("list", nlevs)
-  names(tmp) <- levs
-  if (codes) {
-    tmp[1:nlevs] <- 1:nlevs
-  } else {
-    tmp[1:nlevs] <- levs
-  }
-  return(tmp)
-}
-
-###------------------------------------------------------------------------
-## mapFactor.R ends here

Added: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R	                        (rev 0)
+++ trunk/gdata/R/mapLevels.R	2006-09-13 14:55:37 UTC (rev 979)
@@ -0,0 +1,359 @@
+### mapLevels.R
+###------------------------------------------------------------------------
+### What: Mapping levels
+### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
+### Time-stamp: <2006-08-31 02:24:45 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ mapLevels
+
+###------------------------------------------------------------------------
+
+mapLevels <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+                      combine=FALSE, ...)
+{
+  UseMethod("mapLevels")
+}
+
+mapLevels.default <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+                              combine=FALSE, ...)
+{
+  stop(sprintf("mapLevels can only be used on %s and %s atomic 'x'",
+               dQuote("factor"), dQuote("character")))
+}
+
+mapLevels.character <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+                                combine=FALSE, ...)
+{
+  return(mapLevels.factor(x=x, codes=codes, sort=sort, drop=drop, ...))
+}
+
+## Could coerce character to factor and then use factor method, but that
+## is more expensive than simple unique and length used bellow in factor
+## method
+
+mapLevels.factor <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+                             combine=FALSE, ...)
+{
+  ## --- Argument actions ----
+
+  if(is.factor(x)) { # factor
+    if(drop) x <- factor(x)
+    nlevs <- nlevels(x)
+    levs <- levels(x)
+  } else {           # character
+    levs <- unique(x)
+    nlevs <- length(levs)
+    if(sort) levs <- sort(levs, ...)
+  }
+
+  ## --- Create a map ---
+
+  map <- vector(mode="list", length=nlevs)
+  names(map) <- levs
+  if(codes) {
+    map[1:nlevs] <- 1:nlevs
+  } else {
+    map[1:nlevs] <- levs
+  }
+  class(map) <- "levelsMap"
+  return(map)
+}
+
+mapLevels.list <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+                           combine=FALSE, ...)
+{
+  map <- lapply(x, mapLevels, codes=codes, sort=sort, drop=drop, ...)
+  class(map) <- "listLevelsMap"
+  if(combine) {
+    if(!codes) {
+      return(c(map, sort=sort, recursive=TRUE))
+    } else {
+      stop(sprintf("can not combine integer %s", dQuote("levelsMaps")))
+    }
+  }
+  return(map)
+}
+
+mapLevels.data.frame <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+                                 combine=FALSE, ...)
+{
+  return(mapLevels.list(x, codes=codes, sort=sort, drop=drop,
+                        combine=combine, ...))
+}
+
+### }}}
+### {{{ print.*
+###------------------------------------------------------------------------
+
+.unlistLevelsMap <- function(x, ind=FALSE)
+{
+  y <- unlist(x, use.names=FALSE)
+  length <- sapply(x, FUN=length)
+  names(y) <- rep(names(x), times=length)
+  if(ind) {
+    return(list(y, rep(1:length(x), times=length), length))
+  } else {
+    return(y)
+  }
+}
+
+print.levelsMap <- function(x, ...)
+{
+  x <- gdata:::.unlistLevelsMap(x)
+  print(x, ...)
+}
+
+print.listLevelsMap <- function(x, ...)
+{
+  class(x) <- "list"
+  print(x, ...)
+}
+
+### }}}
+### {{{ [.*
+###------------------------------------------------------------------------
+
+## We need these two since [.list method drops class
+
+"[.levelsMap" <- function(x, i)
+{
+  classX <- class(x)
+  class(x) <- "list"
+  x <- x[i]
+  class(x) <- classX
+  return(x)
+}
+
+"[.listLevelsMap" <- function(x, i)
+{
+  classX <- class(x)
+  class(x) <- "list"
+  x <- x[i]
+  class(x) <- classX
+  return(x)
+}
+
+### }}}
+### {{{ is.*
+###------------------------------------------------------------------------
+
+is.levelsMap <- function(x)
+  inherits(x=x, what="levelsMap")
+
+is.listLevelsMap <- function(x)
+  inherits(x=x, what="listLevelsMap")
+
+.isCharacterMap <- function(x)
+{
+  if(is(x) == "levelsMap") {
+    return(inherits(x=unlist(x), what="character"))
+  } else {
+    stop(sprintf("can be used only on %s", dQuote("levelsMap")))
+  }
+}
+
+### }}}
+### {{{ as.*
+###------------------------------------------------------------------------
+
+as.levelsMap <- function(x, check=TRUE, ...)
+{
+  if(check)
+    gdata:::.checkLevelsMap(x, method="raw")
+  class(x) <- "levelsMap"
+  return(unique(x, ...))
+}
+
+as.listLevelsMap <- function(x, check=TRUE)
+{
+  if(check)
+    gdata:::.checkListLevelsMap(x, method="raw")
+  class(x) <- "listLevelsMap"
+  return(x)
+}
+
+### }}}
+### {{{ .check*
+###------------------------------------------------------------------------
+
+.checkLevelsMap <- function(x, method) {
+  xLab <- deparse(substitute(x))
+  also <- "\b"
+  if(method == "class") {
+    also <- "also"
+    if(!is.levelsMap(x))
+      stop(sprintf("'%s' must be a %s", xLab, dQuote("levelsMap")))
+  }
+  if(!is.list(x) || is.null(names(x)))
+    stop(sprintf("'%s' must be %s a named list", xLab, also))
+
+  ## Components can be of different length
+  ##  if(!all(sapply(x, FUN=length) == 1))
+  ##  stop(sprintf("all components of '%s' must have length 1", xLab))
+}
+
+.checkListLevelsMap <- function(x, method) {
+  xLab <- deparse(substitute(x))
+  also <- "\b"
+  if(method == "class") {
+    also <- "also"
+    if(!is.listLevelsMap(x))
+      stop(sprintf("'%s' must be a %s", xLab, dQuote("listLevelsMap")))
+  }
+  if(!is.list(x) || any(!sapply(x, FUN=is.levelsMap)))
+    stop(sprintf("'%s' must be %s a list of %s", xLab, also,
+                 dQuote("levelsMap")))
+  lapply(x, FUN=gdata:::.checkLevelsMap, method=method)
+}
+
+### }}}
+### {{{ c.*
+###------------------------------------------------------------------------
+
+c.levelsMap <- function(..., sort=TRUE, recursive=FALSE)
+{
+  x <- list(...)
+  class(x) <- "listLevelsMap"
+  return(c(x, sort=sort, recursive=TRUE))
+}
+
+c.listLevelsMap <- function(..., sort=TRUE, recursive=FALSE)
+{
+  x <- list(...)
+  lapply(x, FUN=gdata:::.checkListLevelsMap, method="class")
+  x <- unlist(x, recursive=FALSE)
+  if(!recursive) {
+    class(x) <- "listLevelsMap"
+  } else {
+    if(any(!sapply(x, FUN=gdata:::.isCharacterMap)))
+      stop(sprintf("can not combine integer %s", dQuote("levelsMaps")))
+    if(!is.null(names(x))) names(x) <- NULL
+    x <- unlist(x, recursive=FALSE)
+    ## how to merge components with the same name?
+    class(x) <- "levelsMap"
+    if(sort) x <- sort.levelsMap(x)
+    x <- unique(x)
+  }
+  return(x)
+}
+
+### }}}
+### {{{ sort
+###------------------------------------------------------------------------
+
+sort.levelsMap <- function(x, decreasing=FALSE, na.last=TRUE, ...)
+  return(x[order(names(x), na.last=na.last, decreasing=decreasing)])
+
+### }}}
+### {{{ unique
+###------------------------------------------------------------------------
+
+unique.levelsMap <- function(x, incomparables=FALSE, ...)
+{
+  ## Find duplicates
+  y <- gdata:::.unlistLevelsMap(x, ind=TRUE)
+  ## Duplicates for values and names combinations
+  test <- duplicated(cbind(y[[1]], names(y[[1]])),
+                     incomparables=incomparables, ...)
+  if(any(test)) {
+    if(any(y[[3]] > 1)) { # work with the same structure as in x
+      j <- 1
+      k <- y[[3]][1]
+      empty <- NULL
+      for(i in seq(along=x)) { # how slow is this loop?
+        tmp <- !test[j:k]
+        if(all(!tmp)) { # these components will be empty
+          empty <- c(empty, i)
+        } else {
+          x[[i]] <- x[[i]][tmp]
+        }
+        j <- j + y[[3]][i]
+        k <- k + y[[3]][i + 1]
+      }
+      if(!is.null(empty))
+        x[empty] <- NULL
+    } else { # simple one-length components
+      x <- x[!test]
+    }
+  }
+  return(x)
+}
+
+### }}}
+### {{{ mapLevels<-
+###------------------------------------------------------------------------
+
+"mapLevels<-" <- function(x, value)
+  UseMethod("mapLevels<-")
+
+"mapLevels<-.default" <- function(x, value)
+{
+  ## --- Checks ---
+
+  classX <- c("integer", "character", "factor")
+  if(any(!(class(x) %in% classX)))
+    stop(sprintf("'x' must be either: %s", paste(dQuote(classX), collapse=", ")))
+
+  gdata:::.checkLevelsMap(x=value, method="class")
+
+  ## --- Mapping levels in x ---
+
+  char <- all(lapply(value, is.character))
+  int <- all(lapply(value, is.integer))
+
+  if(int) { # codes=TRUE
+    if(is.integer(x)) x <- factor(x)
+    if(is.factor(x)) levels(x) <- value
+    if(is.character(x))
+      stop(sprintf("can not apply integer %s to %s",
+                   dQuote("levelsMap"), dQuote("character")))
+  } else {  # codes=FALSE
+    if(!char)
+      stop("all components of 'value' must be of the same class")
+    if(is.character(x)) x <- factor(x)
+    if(is.factor(x)) levels(x) <- value
+    if(is.integer(x))
+      stop(sprintf("can not apply character %s to %s",
+                   dQuote("levelsMap"), dQuote("integer")))
+  }
+
+  return(x)
+}
+
+"mapLevels<-.list" <- function(x, value)
+{
+  if(!is.listLevelsMap(value)) {
+    if(is.levelsMap(value)) {
+      value <- as.listLevelsMap(list(value), check=FALSE)
+      ## no need for check as default method does checking anyway
+    } else {
+      stop(sprintf("'x' must be either %s or %s",
+                   dQuote("listLevelsMap"), dQuote("levelsMap")))
+    }
+  }
+  ## FIXME: mapply drops names
+  if(!is.null(names(x))) {
+    isNamed <- TRUE
+    namesX <- names(x)
+  }
+  x <- mapply(FUN="mapLevels<-", x=x, value=value, SIMPLIFY=FALSE)
+  if(isNamed) names(x) <- namesX
+  return(x)
+}
+
+"mapLevels<-.data.frame" <- function(x, value)
+{
+  x[] <- "mapLevels<-.list"(x, value)
+  return(x)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### mapLevels.R ends here

Deleted: trunk/gdata/man/combineLevels.Rd
===================================================================
--- trunk/gdata/man/combineLevels.Rd	2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/man/combineLevels.Rd	2006-09-13 14:55:37 UTC (rev 979)
@@ -1,61 +0,0 @@
-% combineLevels.Rd
-%--------------------------------------------------------------------------
-% What: Combine levels of given factors
-% $Id: combineLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
-% Time-stamp: <2006-06-27 09:30:42 ggorjan>
-%--------------------------------------------------------------------------
-
-\name{combineLevels}
-
-\alias{combineLevels}
-
-\title{Combine levels of given factors}
-
-\description{
-\code{combineLevels} combines levels of given factors and applies this
-levels to given factors. This eases the work with factors since all
-factors have the same levels.  
-}
-
-\usage{
-combineLevels(x, apply=TRUE, drop=FALSE)
-}
-
-\arguments{
-  \item{x}{data.frame or list, object with factors}
-  \item{apply}{boolean, apply combined levels to \code{x} or just return
-    combined levels}
-  \item{drop}{boolean, drop unused levels}
-}
-
-\value{\code{apply} handles the output. If \code{apply=TRUE} the output
-  is a modified \code{x}, where all factors have the same set of
-  levels. If \code{apply=FALSE} only combined levels are returned.  
-}
-
-\author{Gregor Gorjanc}
-
-\seealso{
-  \code{\link{factor}}, \code{\link{levels}}, \code{\link[ggmisc]{mapFactor}}
-}
-
-\examples{
-
-(f1 <- factor(letters[1:5]))
-(f2 <- factor(letters[3:10]))
-tmp <- list(f1, f2)
-combineLevels(tmp)
-combineLevels(tmp, apply=FALSE)
-
-f1[2] <- NA
-f1 <- factor(f1)
-tmp <- list(f1, f2)
-combineLevels(tmp, apply=FALSE, drop=TRUE)
-
-}
-
-\keyword{misc}
-\keyword{manip}
-
-%--------------------------------------------------------------------------
-% combineLevels.Rd ends here

Deleted: trunk/gdata/man/mapFactor.Rd
===================================================================
--- trunk/gdata/man/mapFactor.Rd	2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/man/mapFactor.Rd	2006-09-13 14:55:37 UTC (rev 979)
@@ -1,81 +0,0 @@
-% mapFactor.Rd
-%--------------------------------------------------------------------------
-% What: Get a map of levels in a factor man page
-% $Id: mapFactor.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
-% Time-stamp: <2006-06-27 09:31:03 ggorjan>
-%--------------------------------------------------------------------------
-
-\name{mapFactor}
-
-\alias{mapFactor}
-
-\title{Get a map of levels in a factor}
-
-\description{
-\code{mapFactor} produces a list with information on levels and internal
-integer codes. As such can be conveniently used to store factor map when
-one needs to work with internal codes of a factor and later transfrorm
-back to factor.  
-}
-
-\usage{
-mapFactor(x, codes=TRUE, sort=TRUE, drop=FALSE, ...)
-}
-
-\arguments{
-  \item{x}{factor, the object to be mapped}
-  \item{codes}{boolean, create map with internal codes or with
-    levels, look into value and examples}
-  \item{sort}{boolean, sort levels for a character, look into details}
-  \item{drop}{boolean, drop unused levels of a factor}
-  \item{...}{additional arguments for \code{sort}}
-}
-
-\details{
-  \code{sort} and \code{...} arguments provides possibility to "order"
-  levels and can only be used for characters and not for factors.  
-}
-
-\value{A list with names equal to levels and entries equal to internal
-codes, when \code{codes=TRUE}, or entries equal to levels
-otherwise. The later case is usefull, when one would like to combine
-two factors with different levels.  
-}
-
-\author{Gregor Gorjanc}
-
-\seealso{
-  \code{\link{factor}}, \code{\link{levels}}, \code{\link{unclass}},
-  \code{\link{attributes}}
-}
-
-\examples{
-
-## Example with codes=TRUE
-(f <- factor(letters[c(1, 1, 2, 3, 4, 5, 7, 8, 9, 8, 8, 10)]))
-map <- mapFactor(f)
-int <- as.integer(f)
-fNew <- factor(int)
-levels(fNew) <- map
-fNew
-
-## Example with codes=FALSE
-f1 <- factor(f[1:5])
-f2 <- factor(f[5:length(f)])
-map1 <- mapFactor(f1, codes=FALSE)
-map2 <- mapFactor(f2, codes=FALSE)
-map <- c(map1, map2)
-levels(f1) <- map
-levels(f2) <- map
-as.integer(f1)
-as.integer(f2)
-
-## x <- unique(map)
-## names(x) <- unlist(x)
-}
-
-\keyword{misc}
-\keyword{manip}
-
-%--------------------------------------------------------------------------
-% mapFactor.Rd ends here

Added: trunk/gdata/man/mapLevels.Rd
===================================================================
--- trunk/gdata/man/mapLevels.Rd	                        (rev 0)
+++ trunk/gdata/man/mapLevels.Rd	2006-09-13 14:55:37 UTC (rev 979)
@@ -0,0 +1,221 @@
+% mapLevels.Rd
+%--------------------------------------------------------------------------
+% What: Mapping levels
+% $Id: mapLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
+% Time-stamp: <2006-08-31 02:43:29 ggorjan>
+%--------------------------------------------------------------------------
+
+\name{mapLevels}
+
+\alias{mapLevels}
+\alias{mapLevels.default}
+\alias{mapLevels.factor}
+\alias{mapLevels.character}
+\alias{mapLevels.list}
+\alias{mapLevels.data.frame}
+
+\alias{print.levelsMap}
+\alias{print.listLevelsMap}
+
+\alias{is.levelsMap}
+\alias{is.listLevelsMap}
+
+\alias{as.levelsMap}
+\alias{as.listLevelsMap}
+
+\alias{.checkLevelsMap}
+\alias{.checkListLevelsMap}
+
+\alias{"[.levelsMap"}
+\alias{"[.listLevelsMap"}
+
+\alias{c.levelsMap}
+\alias{c.listLevelsMap}
+
+\alias{unique.levelsMap}
+\alias{sort.levelsMap}
+
+\alias{mapLevels<-}
+\alias{mapLevels<-.default}
+\alias{mapLevels<-.factor}
+\alias{mapLevels<-.character}
+\alias{mapLevels<-.list}
+\alias{mapLevels<-.data.frame}
+
+\title{Mapping levels}
+
+\description{
+
+\code{mapLevels} produces a map with information on levels and/or
+internal integer codes. As such can be conveniently used to store level
+mapping when one needs to work with internal codes of a factor and later
+transfrorm back to factor or when working with several factors that
+should have the same levels and therefore the same internal coding.
+
+}
+
+\usage{
+
+mapLevels(x, codes=TRUE, sort=TRUE, drop=FALSE, combine=FALSE, \ldots)
+mapLevels(x) <- value
+
+}
+
+\arguments{
+  \item{x}{object whose levels will be mapped, look into details}
+  \item{codes}{boolean, create integer levelsMap (with internal
+    codes) or character levelsMap (with level names)}
+  \item{sort}{boolean, sort levels of character \code{x}, look into
+    details}
+  \item{drop}{boolean, drop unused levels}
+  \item{combine}{boolean, combine levels, look into details}
+  \item{\ldots}{additional arguments for \code{sort}}
+  \item{value}{levelsMap or listLevelsMap, output of \code{mapLevels}
+    methods or constructed by user, look into details}
+}
+
+\section{mapLevels}{
+
+\code{mapLevels} function was written primarly for work with
+\dQuote{factors}, but is generic and can also be used with
+\dQuote{character}, \dQuote{list} and \dQuote{data.frame}, while
+\dQuote{default} method produces error. Here the term levels is also
+used for unique character values.
+
+When \code{codes=TRUE} \bold{integer \dQuote{levelsMap}} with
+information on mapping internal codes with levels is produced. Output
+can be used to transform integer to factor or remap factor levels as
+described bellow. With \code{codes=FALSE} \bold{character
+\dQuote{levelsMap}} is produced. The later is usefull, when one would
+like to remap factors or combine factors with some overlap in levels as
+described in \code{mapLevels<-} section and shown in examples.
+
+\code{sort} argument provides possibility to sort levels of
+\dQuote{character} \code{x} and has no effect when \code{x} is a
+\dQuote{factor}.
+
+Argument \code{combine} has effect only in \dQuote{list} and
+\dQuote{data.frame} methods and when \code{codes=FALSE} i.e. with
+\bold{character \dQuote{levelsMaps}}. The later condition is necesarry
+as it is not possible to combine maps with different mapping of level
+names and integer codes. It is assumed that passed \dQuote{list} and
+\dQuote{data.frame} have all components for which methods
+exist. Otherwise error is produced.
+
+}
+
+\section{levelsMap and listLevelsMap}{
+
+Function \code{mapLevels} returns a map of levels. This map is of class
+\dQuote{levelsMap}, which is actually a list of length equal to number
+of levels and with each component of length 1. Components need not be of
+length 1. There can be either integer or character
+\dQuote{levelsMap}. \bold{Integer \dQuote{levelsMap}} (when
+\code{codes=TRUE}) has names equal to levels and components equal to
+internal codes. \bold{Character \dQuote{levelsMap}} (when
+\code{codes=FALSE}) has names and components equal to levels. When
+\code{mapLevels} is applied to \dQuote{list} or \dQuote{data.frame},
+result is of class \dQuote{listLevelsMap}, which is a list of
+\dQuote{levelsMap} components described previously. If
+\code{combine=TRUE}, result is a \dQuote{levelsMap} with all levels in
+\code{x} components.
+
+For ease of inspection, print methods unlists \dQuote{levelsMap} with
+proper names. \code{mapLevels<-} methods are fairly general and
+therefore additional convenience methods are implemented to ease the
+work with maps: \code{is.levelsMap} and \code{is.listLevelsMap};
+\code{as.levelsMap} and \code{as.listLevelsMap} for coercion of user
+defined maps; generic \code{"["} and \code{c} for both classes (argument
+\code{recursive} can be used in \code{c} to coerce
+\dQuote{listLevelsMap} to \dQuote{levelsMap}) and generic \code{unique}
+and \code{sort} (generic from \R 2.4) for \dQuote{levelsMap}.
+
+}
+
+\section{mapLevels<-}{
+
+Workhorse under \code{mapLevels<-} methods is
+\code{\link{levels<-}}. \code{mapLevels<-} just control the assignment
+of \dQuote{levelsMap} (integer or character) or \dQuote{listLevelsMap}
+to \code{x}. The idea is that map values are changed to map names as
+indicated in \code{\link{levels}} examples. \bold{Integer
+\dQuote{levelsMap}} can be applied to \dQuote{integer} or
+\dQuote{factor}, while \bold{character \dQuote{levelsMap}} can be
+applied to \dQuote{character} or \dQuote{factor}. Methods for
+\dQuote{list} and \dQuote{data.frame} can work only on mentioned atomic
+components/columns and can accept either \dQuote{levelsMap} or
+\dQuote{levelsMap}. Recycling occours, if length of \code{value} is not
+the same as number of components/columns of a \dQuote{list/data.frame}.
+}
+
+\value{
+
+\code{mapLevels()} returns \dQuote{levelsMap} or \dQuote{listLevelsMap}
+objects as described in levelsMap and listLevelsMap section.
+
+Result of \code{mapLevels<-} is always a factor with remapped levels or
+a \dQuote{list/data.frame} with remapped factors.
+
+}
+
+\author{Gregor Gorjanc}
+
+\seealso{
+  \code{\link{factor}}, \code{\link{levels}} and \code{\link{unclass}}
+}
+
+\examples{
+
+## --- Integer levelsMap ---
+
+(f <- factor(sample(letters, size=20, replace=TRUE)))
+(mapInt <- mapLevels(f))
+
+## Integer to factor
+(int <- as.integer(f))
+(mapLevels(int) <- mapInt)
+all.equal(int, f)
+
+## Remap levels of a factor
+(fac <- factor(as.integer(f)))
+(mapLevels(fac) <- mapInt) # the same as levels(fac) <- mapInt
+all.equal(fac, f)
+
+## --- Character levelesMap ---
+
+f1 <- factor(letters[1:10])
+f2 <- factor(letters[5:14])
+
+## Internal codes are the same, but levels are not
+as.integer(f1)
+as.integer(f2)
+
+## Get character levelsMaps and combine them
+mapCha1 <- mapLevels(f1, codes=FALSE)
+mapCha2 <- mapLevels(f2, codes=FALSE)
+(mapCha <- c(mapCha1, mapCha2))
+
+## Remap factors
+mapLevels(f1) <- mapCha # the same as levels(f1) <- mapCha
+mapLevels(f2) <- mapCha # the same as levels(f2) <- mapCha
+
+## Internal codes are now "consistent" among factors
+as.integer(f1)
+as.integer(f2)
+
+## Remap characters to get factors
+f1 <- as.character(f1); f2 <- as.character(f2)
+mapLevels(f1) <- mapCha
+mapLevels(f2) <- mapCha
+
+## Internal codes are now "consistent" among factors
+as.integer(f1)
+as.integer(f2)
+
+}
+
+\keyword{misc}
+\keyword{manip}
+
+%--------------------------------------------------------------------------
+% mapLevels.Rd ends here


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [978] trunk/gdata

[<wa...@us...>]

Revision: 978
Author:   warnes
Date:     2006-08-03 15:26:30 -0700 (Thu, 03 Aug 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=978&view=rev

Log Message:
-----------
Add Gregor Gorjanc's mapFactor() and combineLevels() functions. 

Modified Paths:
--------------
    trunk/gdata/DESCRIPTION
    trunk/gdata/NAMESPACE

Added Paths:
-----------
    trunk/gdata/R/combineLevels.R
    trunk/gdata/R/mapFactor.R
    trunk/gdata/man/combineLevels.Rd
    trunk/gdata/man/mapFactor.Rd
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION	2006-08-02 22:21:49 UTC (rev 977)
+++ trunk/gdata/DESCRIPTION	2006-08-03 22:26:30 UTC (rev 978)
@@ -3,9 +3,8 @@
 Description: Various R programming tools for data manipulation
 Depends: R (>= 1.9.0)
 Imports: gtools
-Version: 2.1.3
-Date: 2005-10-27
+Version: 2.2.0
 Author: Gregory R. Warnes. Includes R source code and/or documentation
-        contributed by Ben Bolker and Thomas Lumley
+        contributed by Ben Bolker, Gregor Gorjanc, and Thomas Lumley
 Maintainer: Gregory Warnes <gre...@ur...>
 License: GPL (version 2 or later)

Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2006-08-02 22:21:49 UTC (rev 977)
+++ trunk/gdata/NAMESPACE	2006-08-03 22:26:30 UTC (rev 978)
@@ -3,6 +3,7 @@
        Args,
        aggregate.table,
        combine,
+       combineLevels,
        ConvertMedUnits,
        drop.levels,
        elem,
@@ -13,7 +14,8 @@
        keep,
        ll,
        lowerTriangle,
-       "lowerTriangle<-",       
+       "lowerTriangle<-",
+       mapFactor,
        matchcols,
        nobs,
        read.xls,

Added: trunk/gdata/R/combineLevels.R
===================================================================
--- trunk/gdata/R/combineLevels.R	                        (rev 0)
+++ trunk/gdata/R/combineLevels.R	2006-08-03 22:26:30 UTC (rev 978)
@@ -0,0 +1,26 @@
+## combineLevels.R
+###------------------------------------------------------------------------
+## What: Joint levels of given factors
+## $Id: combineLevels.R,v 1.1 2006/04/08 01:58:36 ggorjan Exp $
+## Time-stamp: <2006-04-08 03:57:53 ggorjan>
+###------------------------------------------------------------------------
+
+combineLevels <- function(x, apply=TRUE, drop=FALSE)
+{
+  if (!is.factor(x)) {
+    if (sum(!(c("data.frame", "list") %in% class(x))) == 2)
+      stop(paste(sQuote("x"), "must be a", dQuote("data.frame"), "or a", dQuote("list")))
+    if (any(!(unlist((lapply(x, is.factor))))))
+      stop(paste("only", dQuote("factors"), "are supported"))
+    if (drop) x <- lapply(x, factor)
+    levs <- sort(unique(unlist(lapply(x, levels))))
+    if (!apply) return(levs)
+    return(lapply(x, "levels<-", mapFactor(levs, codes=FALSE)))
+  }
+  if (drop) x <- factor(x)
+  if (!apply) return(levels(x))
+  return(x)
+}
+
+###------------------------------------------------------------------------
+## combineLevels.R ends here

Added: trunk/gdata/R/mapFactor.R
===================================================================
--- trunk/gdata/R/mapFactor.R	                        (rev 0)
+++ trunk/gdata/R/mapFactor.R	2006-08-03 22:26:30 UTC (rev 978)
@@ -0,0 +1,38 @@
+## mapFactor.R
+###------------------------------------------------------------------------
+## What: Get a map of levels in a factor
+## $Id: mapFactor.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
+## Time-stamp: <2006-04-06 01:35:30 ggorjan>
+###------------------------------------------------------------------------
+
+mapFactor <- function(x, codes=TRUE, sort=TRUE, drop=FALSE, ...)
+{
+  ## --- Check ---
+  msg <- "x must be a factor or character"
+  if (!is.factor(x)) {
+    if (!is.character(x)) stop(msg)
+  }
+
+  ## --- Create a map ---
+  if (is.factor(x)) { # factor
+    if (drop) x <- factor(x)
+    nlevs <- nlevels(x)
+    levs <- levels(x)
+    if (sort) levs <- sort(levs, ...)
+  } else {            # character
+    levs <- unique(x)
+    if (sort) levs <- sort(levs, ...)
+    nlevs <- length(levs)
+  }
+  tmp <- vector("list", nlevs)
+  names(tmp) <- levs
+  if (codes) {
+    tmp[1:nlevs] <- 1:nlevs
+  } else {
+    tmp[1:nlevs] <- levs
+  }
+  return(tmp)
+}
+
+###------------------------------------------------------------------------
+## mapFactor.R ends here

Added: trunk/gdata/man/combineLevels.Rd
===================================================================
--- trunk/gdata/man/combineLevels.Rd	                        (rev 0)
+++ trunk/gdata/man/combineLevels.Rd	2006-08-03 22:26:30 UTC (rev 978)
@@ -0,0 +1,61 @@
+% combineLevels.Rd
+%--------------------------------------------------------------------------
+% What: Combine levels of given factors
+% $Id: combineLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
+% Time-stamp: <2006-06-27 09:30:42 ggorjan>
+%--------------------------------------------------------------------------
+
+\name{combineLevels}
+
+\alias{combineLevels}
+
+\title{Combine levels of given factors}
+
+\description{
+\code{combineLevels} combines levels of given factors and applies this
+levels to given factors. This eases the work with factors since all
+factors have the same levels.  
+}
+
+\usage{
+combineLevels(x, apply=TRUE, drop=FALSE)
+}
+
+\arguments{
+  \item{x}{data.frame or list, object with factors}
+  \item{apply}{boolean, apply combined levels to \code{x} or just return
+    combined levels}
+  \item{drop}{boolean, drop unused levels}
+}
+
+\value{\code{apply} handles the output. If \code{apply=TRUE} the output
+  is a modified \code{x}, where all factors have the same set of
+  levels. If \code{apply=FALSE} only combined levels are returned.  
+}
+
+\author{Gregor Gorjanc}
+
+\seealso{
+  \code{\link{factor}}, \code{\link{levels}}, \code{\link[ggmisc]{mapFactor}}
+}
+
+\examples{
+
+(f1 <- factor(letters[1:5]))
+(f2 <- factor(letters[3:10]))
+tmp <- list(f1, f2)
+combineLevels(tmp)
+combineLevels(tmp, apply=FALSE)
+
+f1[2] <- NA
+f1 <- factor(f1)
+tmp <- list(f1, f2)
+combineLevels(tmp, apply=FALSE, drop=TRUE)
+
+}
+
+\keyword{misc}
+\keyword{manip}
+
+%--------------------------------------------------------------------------
+% combineLevels.Rd ends here

Added: trunk/gdata/man/mapFactor.Rd
===================================================================
--- trunk/gdata/man/mapFactor.Rd	                        (rev 0)
+++ trunk/gdata/man/mapFactor.Rd	2006-08-03 22:26:30 UTC (rev 978)
@@ -0,0 +1,81 @@
+% mapFactor.Rd
+%--------------------------------------------------------------------------
+% What: Get a map of levels in a factor man page
+% $Id: mapFactor.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
+% Time-stamp: <2006-06-27 09:31:03 ggorjan>
+%--------------------------------------------------------------------------
+
+\name{mapFactor}
+
+\alias{mapFactor}
+
+\title{Get a map of levels in a factor}
+
+\description{
+\code{mapFactor} produces a list with information on levels and internal
+integer codes. As such can be conveniently used to store factor map when
+one needs to work with internal codes of a factor and later transfrorm
+back to factor.  
+}
+
+\usage{
+mapFactor(x, codes=TRUE, sort=TRUE, drop=FALSE, ...)
+}
+
+\arguments{
+  \item{x}{factor, the object to be mapped}
+  \item{codes}{boolean, create map with internal codes or with
+    levels, look into value and examples}
+  \item{sort}{boolean, sort levels for a character, look into details}
+  \item{drop}{boolean, drop unused levels of a factor}
+  \item{...}{additional arguments for \code{sort}}
+}
+
+\details{
+  \code{sort} and \code{...} arguments provides possibility to "order"
+  levels and can only be used for characters and not for factors.  
+}
+
+\value{A list with names equal to levels and entries equal to internal
+codes, when \code{codes=TRUE}, or entries equal to levels
+otherwise. The later case is usefull, when one would like to combine
+two factors with different levels.  
+}
+
+\author{Gregor Gorjanc}
+
+\seealso{
+  \code{\link{factor}}, \code{\link{levels}}, \code{\link{unclass}},
+  \code{\link{attributes}}
+}
+
+\examples{
+
+## Example with codes=TRUE
+(f <- factor(letters[c(1, 1, 2, 3, 4, 5, 7, 8, 9, 8, 8, 10)]))
+map <- mapFactor(f)
+int <- as.integer(f)
+fNew <- factor(int)
+levels(fNew) <- map
+fNew
+
+## Example with codes=FALSE
+f1 <- factor(f[1:5])
+f2 <- factor(f[5:length(f)])
+map1 <- mapFactor(f1, codes=FALSE)
+map2 <- mapFactor(f2, codes=FALSE)
+map <- c(map1, map2)
+levels(f1) <- map
+levels(f2) <- map
+as.integer(f1)
+as.integer(f2)
+
+## x <- unique(map)
+## names(x) <- unlist(x)
+}
+
+\keyword{misc}
+\keyword{manip}
+
+%--------------------------------------------------------------------------
+% mapFactor.Rd ends here


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [976] trunk/gdata/data/MedUnits.rda

[<wa...@us...>]

Revision: 976
Author:   warnes
Date:     2006-08-02 14:03:43 -0700 (Wed, 02 Aug 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=976&view=rev

Log Message:
-----------
Remove MedUnits.rda to convert to binary format

Added Paths:
-----------
    trunk/gdata/data/MedUnits.rda
Added: trunk/gdata/data/MedUnits.rda
===================================================================
(Binary files differ)


Property changes on: trunk/gdata/data/MedUnits.rda
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [975] trunk/gdata/data/MedUnits.rda

[<wa...@us...>]

Revision: 975
Author:   warnes
Date:     2006-08-02 14:03:07 -0700 (Wed, 02 Aug 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=975&view=rev

Log Message:
-----------
Remove MedUnits.rda to convert to binary format

Removed Paths:
-------------
    trunk/gdata/data/MedUnits.rda
Deleted: trunk/gdata/data/MedUnits.rda
===================================================================
--- trunk/gdata/data/MedUnits.rda	2006-08-02 19:06:46 UTC (rev 974)
+++ trunk/gdata/data/MedUnits.rda	2006-08-02 21:03:07 UTC (rev 975)
@@ -1,39 +0,0 @@
-RDX2
-X
-

[R-gregmisc-users] SF.net SVN: r-gregmisc: [974] trunk/gdata/DESCRIPTION

[<wa...@us...>]

Revision: 974
Author:   warnes
Date:     2006-08-02 12:06:46 -0700 (Wed, 02 Aug 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=974&view=rev

Log Message:
-----------
Update version number

Modified Paths:
--------------
    trunk/gdata/DESCRIPTION
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION	2006-08-02 19:04:55 UTC (rev 973)
+++ trunk/gdata/DESCRIPTION	2006-08-02 19:06:46 UTC (rev 974)
@@ -3,9 +3,9 @@
 Description: Various R programming tools for data manipulation
 Depends: R (>= 1.9.0)
 Imports: gtools
-Version: 2.1.2
+Version: 2.1.3
 Date: 2005-10-27
 Author: Gregory R. Warnes. Includes R source code and/or documentation
         contributed by Ben Bolker and Thomas Lumley
-Maintainer: Nitin Jain <nit...@pf...>
+Maintainer: Gregory Warnes <gre...@ur...>
 License: GPL (version 2 or later)


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [973] trunk/gdata

[<wa...@us...>]

Revision: 973
Author:   warnes
Date:     2006-08-02 12:04:55 -0700 (Wed, 02 Aug 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=973&view=rev

Log Message:
-----------
Integrate changes suggested by Gregor Gorjanc

Modified Paths:
--------------
    trunk/gdata/NAMESPACE
    trunk/gdata/R/drop.levels.R
    trunk/gdata/R/trim.R
    trunk/gdata/man/drop.levels.Rd
    trunk/gdata/man/trim.Rd
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/NAMESPACE	2006-08-02 19:04:55 UTC (rev 973)
@@ -36,5 +36,11 @@
 S3method(trim, character)
 S3method(trim, default)
 S3method(trim, factor)
+S3method(trim, list)
+S3method(trim, data.frame)
 S3method(reorder,factor)
 
+S3method(drop.levels, default)
+S3method(drop.levels, factor)
+S3method(drop.levels, list)
+S3method(drop.levels, data.frame)

Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/R/drop.levels.R	2006-08-02 19:04:55 UTC (rev 973)
@@ -1,10 +1,24 @@
-drop.levels <- function(x, reorder = TRUE, ...) {
- as.data.frame(lapply(x, function(xi) {
-    if(is.factor(xi)) {
-      xi <- factor(xi)
-      if(reorder)
-        xi <- reorder(xi, ...)
-    }
-    xi
-  }))
+
+drop.levels  <- function(x, reorder=TRUE, ...)
+  UseMethod("drop.levels")
+
+drop.levels.default <- function(x, reorder=TRUE, ...)
+  return(x)
+
+drop.levels.factor <- function(x, reorder=TRUE, ...)
+{
+  x <- factor(x)
+  if(reorder) x <- reorder(x, ...)
+  return(x)
 }
+
+drop.levels.list <- function(x, reorder=TRUE, ...)
+{
+  return(lapply(x, drop.levels, reorder=reorder, ...))
+}
+
+drop.levels.data.frame <- function(x, reorder=TRUE, ...)
+{
+  x[] <- drop.levels.list(x, reorder=reorder, ...)
+  return(x)
+}

Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/R/trim.R	2006-08-02 19:04:55 UTC (rev 973)
@@ -1,23 +1,29 @@
 # $Id$
 
 trim <- function(s)
-  UseMethod("trim",s)
+  UseMethod("trim", s)
 
 trim.default <- function(s)
-  {
-    s <- sub("^ +","",s)
-    s <- sub(" +$","",s)
-    s
-  }
+  return(s)
 
 trim.character <- function(s)
 {
-  return(trim.default(s))
+  s <- sub(pattern="^ +", replacement="", x=s)
+  s <- sub(pattern=" +$", replacement="", x=s)
+  return(s)
 }
 
 trim.factor <- function(s)
 {
-  levels(s) <- trim.default(levels(s))
+  levels(s) <- trim(levels(s))
   return(s)
 }
 
+trim.list <- function(s)
+  return(lapply(s, trim))
+
+trim.data.frame <- function(s)
+{
+  s[] <- trim.list(s)
+  return(s)
+}

Modified: trunk/gdata/man/drop.levels.Rd
===================================================================
--- trunk/gdata/man/drop.levels.Rd	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/man/drop.levels.Rd	2006-08-02 19:04:55 UTC (rev 973)
@@ -3,18 +3,43 @@
 \name{drop.levels}
 \alias{drop.levels}
 \title{Drop unused factor levels}
-\description{Drop unused factor levels for every factor variable in a data frame.
-}
+\description{Drop unused levels in a factor.}
 \usage{
-drop.levels(x, reorder = TRUE, ...)
+drop.levels(x, reorder=TRUE, ...)
 }
 \arguments{
-  \item{x}{a data frame}
+  \item{x}{object to be processed}
   \item{reorder}{should factor levels be reordered using
     \code{\link{reorder.factor}}?}
   \item{...}{additional arguments to \code{reorder.factor}}
 }
-\value{a data frame
+
+\details{
+
+\code{drop.levels} is a generic function, where default method does
+nothing, while method for factor \code{s} drops all unused levels. There
+are also convinient methods for \code{list} and \code{data.frame}, where
+all unused levels are droped in all factors (one by one) in a
+\code{list} or a \code{data.frame}.
+
 }
+
+\value{a data frame}
+
 \author{Jim Rogers \email{jam...@pf...}}
+
+\examples{
+
+f <- factor(c("A", "B", "C", "D"))[1:3]
+drop.levels(f)
+
+l <- list(f=f, i=1:3, c=c("A", "B", "D"))
+drop.levels(l)
+
+df <- as.data.frame(l)
+str(df)
+str(drop.levels(df))
+
+}
+
 \keyword{manip}

Modified: trunk/gdata/man/trim.Rd
===================================================================
--- trunk/gdata/man/trim.Rd	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/man/trim.Rd	2006-08-02 19:04:55 UTC (rev 973)
@@ -8,15 +8,34 @@
 trim(s)
 }
 \arguments{
-  \item{s}{character string(s) to be processed}
+  \item{s}{object to be processed}
 }
+
+\details{
+
+\code{trim} is a generic function, where default method does nothing,
+while method for character \code{s} trims its elements and method for
+factor \code{s} trims \code{\link{levels}}. There are also methods for
+\code{list} and \code{data.frame}.
+
+}
 \value{
-  Elements of \code{s} with all leading and traling spaces removed.
+  \code{s} with all leading and traling spaces removed in its elements.
 }
 \author{ Gregory R. Warnes \email{gre...@pf...} }
 \seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} }
 \examples{
 s <- "    this is an example string    "
 trim(s)
+
+f <- c(s, s, " A", " B ", "  C ", "D ")
+trim(f)
+
+l <- list(s=rep(s, times=6), f=f, i=1:6)
+trim(l)
+
+df <- as.data.frame(l)
+trim(df)
+
 }
 \keyword{character}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [971] trunk/OpenSourceInPharma/talk.tex

[<wa...@us...>]

Revision: 971
Author:   warnes
Date:     2006-07-28 16:20:45 -0700 (Fri, 28 Jul 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=971&view=rev

Log Message:
-----------
Updates to get ready for JSM

Modified Paths:
--------------
    trunk/OpenSourceInPharma/talk.tex
Modified: trunk/OpenSourceInPharma/talk.tex
===================================================================
--- trunk/OpenSourceInPharma/talk.tex	2006-07-24 21:23:26 UTC (rev 970)
+++ trunk/OpenSourceInPharma/talk.tex	2006-07-28 23:20:45 UTC (rev 971)
@@ -28,28 +28,35 @@
 \title{Open Source Software in Pharmaceutical Research}
 
 \author{
-  Gregory R. Warnes\inst{1} \and 
+  Gregory R. Warnes\inst{1}\inst{2}\inst{3} \and 
   James A. Rogers\inst{2} \and
-  A. Max Kuhn\inst{2}
+  Max Kuhn\inst{2}
 }
 
-\institute[U. Rochester, Pfizer]{
-  \inst{1}%
+\institute{
+ \inst{1}%
+  Center for Biodefense Immune Modeling, University of Rochester \vspace{-5pt}
+  \and
+ \inst{2}%
   Department of Biostatistics and Computational Biology, University of Rochester \vspace{-5pt}
   \and
-  \inst{2}%
-  Statistical Applications, Pfizer, Inc. \vspace{-5pt}
+ \inst{3}%
+  REvolution Computing, Inc.\vspace{-5pt}
+  \and
+  \inst{4}%
+  Research Statistics, Pfizer, Inc. \vspace{-5pt}
 }
 
 
 \date[2006 JSM]{Joint Statistical Meetings, Seattle, WA, Aug 6-9, 2006}
+%\date[UseR! 2006]{UseR! 2006, Vienna, Austria, June 15-19, 2006}
 
 \begin{document}
 \frame{\titlepage}
 
 \frame{
 \begin{abstract}
-\setbeamerfont{small}{size=\tiny}
+\setbeamerfont{small}{size=\small}
 \usebeamerfont{small}
   
 Open-Source statistical software is being used with increasing
@@ -62,7 +69,7 @@
 
 \vspace{1em}
 
-We will focus on R, a full-featured open-source statistical
+We will focus on \textsc{R}, a full-featured open-source statistical
 software package. We'll briefly outline the benefits it provides, as
 seen from the perspective of a discovery statistician, show some
 example areas in which it may be used, and then discuss the
@@ -73,10 +80,10 @@
 Next we will discuss what is needed for organizations to be
 comfortable with employing open-source statistical software for
 regulatory use within clinical, safety, or manufacturing. We will
-then talk about how well or poorly R meets these requirements,
+then talk about how well or poorly \textsc{R} meets these requirements,
 highlighting current issues.  Finally, we will discuss options for
-third-party commercial support for R, and evaluate how well they
-meet the requirements for use of R within both regulated and
+third-party commercial support for \textsc{R}, and evaluate how well they
+meet the requirements for use of \textsc{R} within both regulated and
 non-regulated contexts.
 
 \end{abstract}
@@ -84,7 +91,7 @@
 
 \frame{
   \frametitle{Outline}
-  \tableofcontents[pausesections] 
+  \tableofcontents%[pausesections] 
 
 }
 
@@ -117,149 +124,324 @@
   \item Documentable
   \item Auditable
   \item Stable
+  \item Supported
   \end{enumerate}
 }
 
 \frame{
-\frametitle{Requirements (detail)}
+\frametitle{Requirements: Details (I)}
 
 \begin{description}[<+->]
 
-\item[Functional] Performs the reqiured tasks
+\item[Functional] Performs the required tasks
 
-\item[Verifiable] Demonstrate that computer output is correct, or at least consustent..
+\item[Verifiable] Demonstrate that computer output is correct, or at least consistent..
 
 \item[Repeatable] Given the same data, the same results can be
   obtained, potentially much later in time.
 
-\item[Documentable] Documentation is avaiable or can easily be
-  generated for the entire software lifecycle: Specification, Design,
+\item[Documentable] Documentation is available or can easily be
+  generated for the entire software life-cycle: Specification, Design,
   Development. Testing, Deployment, Change Management
 
+
 \end{description}
-
 }
 
 \frame{
-  \frametitle{Requirements (detail, cont)}
+\frametitle{Requirements: Details (II)}
 
-\begin{description}
+\begin{description}[<+->]
 
 \item[Auditable] Track everything done to data and the system
 
 \item[Stable] Doesn't change too fast, so that there is enough time to
   develop required documentation
+  
+\item[Supported] Guaranteed (by \$\$) availability of external expense
+  for installation, problem resolution, bug fixes, feature
+  development, training, application development, consulting
 
-\item[Supported] Guaranteed (by \$\$) availability of external expense for
-  \begin{itemize}
-    \item installation
-    \item problem resolution
-    \item bug fixes
-    \item feature development
-    \item training
-    \item application development
-    \item consulting
-  \end{itemize}
-
 \end{description}
 }
 
-\section{What is R?}
+\section{What is \textsc{R}?}
 
 \frame{
-  \frametitle{What is R?}
+  \frametitle{What is \textsc{R}?}
+  
+  \begin{itemize}[<+->]
 
-  \begin{itemize}
-    \item{foo}
-  \end{itemize}
+    \item System for statistical computing and graphics
+
+    \item Language is very similar to the S-Plus
+      
+    \item Full featured support for statistical and graphical techniques:
+
+      \begin{itemize}[<1->]
+      \item linear and nonlinear modeling,
+      \item classical statistical tests,
+      \item time-series analysis,
+      \item classification,
+      \item clustering
+      \item ...
+      \end{itemize}
+
+    \item Highly extensible with good development tools
+      
+    \item \emph{Huge} library of user-contributed add-on packages: $>850$ ! 
+      
+    \item Source code is freely available
+
+\end{itemize}
 }
 
+\section{Status of \textsc{R}}
 
-\section{ Status of R}
-
 \frame{
-  \frametitle{Status of R}
+  \frametitle{Status of \textsc{R} (I)}
 
-\begin{description}
+\begin{description}[<+->]
 
-\item[Functional] +++ This is R's strength, and is largely provided by
-  user-supplied add on packages.  R currently provides more
+\item[Functional] +++ This is \textsc{R}'s strength. Largely provided by
+  the $>850$ user-supplied add-on packages.  \textsc{R} currently provides more
   functionality than any other statistical software system and is
   growing rapidly.
 
-\item[Verifiable] --- Most of the functionality of R comes from
-  user-developed add-on packages, but there is currently no formal
-  mechanism for evaluating the level of quality of these packages (eg:
+\item[Verifiable] --- Most of the functionality of \textsc{R} comes from
+  user-developed add-on packages ($>850$!), but there is currently no formal
+  mechanism for evaluating the level of quality of these packages (e.g.:
   development, test, production, peer reviewed, validated) or
   documentation that they accomplish the required tasks.
+  
+\item[Repeatable] --- Currently, add on packages do not display
+  version information when loaded, making it difficult to know what
+  versions were utilized for a given analysis, and thus impossible to
+  reliably replicated.
 
-\item[Repeatable] --- 
+\end{description}
+}
+\frame{
+\frametitle{Status of \textsc{R} (II)}
 
-\item[Documentable] --- While the R core team has a well defined and
+\begin{description}[<+->]
+
+\item[Documentable] --- While the \textsc{R} core team has a well defined and
   managed process for design, development, testing, release, and
   change management, no formal documentation of this process appears
   to exists (aside from the specifications of the language itself).
   No centrally defined or managed process appears to exist for add-on
   packages.
+
+\item[Auditable] --- \textsc{R} has no built-in no audit log, either for data
+  analysis steps or for changes to the system (e.g.: package updates,
+  patches)
+
 \end{description}
 }
-
 \frame{
+\frametitle{Status of \textsc{R} (III)}
 
-  \frametitle{Status of R (cont)}
+\begin{description}[<+->]
 
-\begin{description}
-
-\item[Auditable] --- R has no built-in no audit log, either for data
-  analysis steps or for changes to the system (e.g.: package updates,
-  patches)
-
-\item[Stable] --- The R core team releases minor (major.minor.patch)
+\item[Stable] --- The \textsc{R} core team releases minor (major.minor.patch)
   versions twice a year.  Since bug fixes are currently applied only
   to the latest released version of the system, it is difficult to
   properly support embedded and validated systems where one may need
-  to resolve bugs in R, but must constrain the R version to remain
+  to resolve bugs in \textsc{R}, but must constrain the \textsc{R} version to remain
   constant for long periods due to the burden of documentation and
   testing that must be performed.
 
-\item[Supported] While there is an increasingly large pool of
-  statisticians and statistical consulting groups that have R
-  expertise, no organization formally supports R at this time.
+\item[Supported] --- While there is an increasingly large pool of
+  statisticians and statistical consulting groups that have \textsc{R}
+  expertise, no organization formally supports \textsc{R} at this time.
 
 \end{description}
 }
 
-\section{ What needs to be done?}
+\section{Moving Forward}
 
 \frame{
-  \frametitle{Status of R (cont)}
+  \frametitle{Moving Forward (I)}
 
+\begin{description}[<+->]
+  \item[Functional] Already a strength. Continue!
+  \item[Verifiable] \textsc{RForge} proposal
+    \begin{enumerate}
+      \item Develop a SourceForge-like system for contributed packages: 
+%        \begin{itemize}
+%        \item version control system (subversion)
+%        \item issue tracking system
+%        \item file release area
+%        \item web page
+%        \item news lists
+%        \end{itemize} for each individual package.
+      \item Support package status categories, including clear standards
+        \begin{itemize}[<1->]
+        \item development,
+        \item testing,
+        \item production, or
+        \item peer-reviewed/validated.
+        \end{itemize}
+      \end{enumerate}
+  \item[Repeatable] Display versions of packages on load
+
+\end{description}
 }
 
-\begin{frame}[allowframebreaks]
-  \frametitle<presentation>{For Further Reading}
+\frame{
+  \frametitle{Moving Forward (II)}
+
+\begin{description}[<+->]
+
+  \item[Documentable] ~ 
+    \begin{enumerate}
+    \item Formally document the development process used for \textsc{R}
+    \item Provide tools to perform and document this process for
+      add-on packages
+    \item Develop validation templates for use by organizations
+    \item Encourage commercial vendors to support \textsc{R} and to provide
+      additional validation effort and associated documentation.
+    \end{enumerate}
+  \item[Auditable] Add an audit-log facility
+  \item[Stable] Establish a system for back-porting bug fixes to
+    previous versions.
+  \item[Supported] Encourage commercial vendors to formally support \textsc{R}.
+\end{description}
+}
+
+\section{News Flash!}
+
+\frame{
+  \frametitle{News Flash!: \textsc{RPro} from \emph{REvolution Computing} }
+
+  \setbeamerfont{small}{size=\small}
+  \usebeamerfont{small}
+  
+  
+  2006-08-01 {\bf New Haven, CT}: \emph{REvolution Computing}
+  announces the immediate availability of \textsc{RPro}, an enterprise-strength
+  statistical computing environment providing the strengths of the
+  open source \textsc{R} statistical software system from the R-Project coupled
+  with the enterprise-level support and high-performance computing
+  expertise of \emph{REvolution Computing}.
+
+  \vspace{1em}
+
+  \begin{columns}[c] 
+    \begin{column}{0.5\textwidth} 
+      Additions to \textsc{R}:
+      
+      \begin{itemize}
+        
+      \item Technical Support
+        
+      \item Simple Installation and Maintenance
+        
+      \item Performance Tuning
+        
+      \item Documentation and Training
+        
+      \item Validation Materials
+        
+      \item Consulting and Services
+        
+      \end{itemize}
+      
+    \end{column} 
+    \begin{column}{0.5\textwidth} 
+      \includegraphics*[width=\textwidth]{RevolutionComputingInfo.pdf}
+    \end{column} 
+  \end{columns} 
+  
+}
+
+\frame{
+  
+\frametitle{News Flash!: \textsc{NetWorkSpaces} from 
+  \emph{REvolution Computing}
+  }
+
+  \setbeamerfont{small}{size=\small}
+  \usebeamerfont{small}
+
+  2006-08-01 {\bf New Haven, CT}: \emph{REvolution Computing}
+  announces the immediate availability of \textsc{NetWorkSpaces} for
+  \textsc{RPro} (\textsc{NWS}). \textsc{NWS} enables calculations to
+  be automatically distributed across multiple processors in clusters.
+  Distributing the data and/or work across multiple processors permits
+  a dramatic decrease in time to completion of large computational
+  tasks or permits a dramatic increase in those calculations size,
+  length or complexity.  \textsc{NWS} fully supports Microsoft Windows
+  Compute Cluster Server 2003 (\textsc{CCS}), which provides a
+  security enhanced and affordable high performance computing
+  solution.
+
+\begin{columns}[c] 
+\begin{column}{0.5\textwidth} 
+  \includegraphics*[width=\textwidth]{MicrosoftWindowsClusterComputeServer2003.pdf}
+\end{column} 
+\begin{column}{0.5\textwidth} 
+  \includegraphics*[width=\textwidth]{RevolutionComputingInfo.pdf}
+\end{column} 
+\end{columns} 
+
+}
+
+
+\section{More Information}
+
+\frame{
+  \frametitle<presentation>{Contact Information}
+
+\begin{itemize}
+  \item Personal:
+    \begin{description}
+    \item[Email] gr...@wa...
+    \item[Web] http://www.warnes.net/Research
+    \end{description}
+    \vspace{1em}
+
+  \item University of Rochester:
+    \begin{description}
+    \item[Email] wa...@bs...
+    \item[Web] http://www.urmc.rochester.edu/smd/biostat
+    \end{description}
+    \vspace{1em}
     
-  \begin{thebibliography}{10}
+  \item REvolution Computing:
+    \begin{description}
+    \item[Email] gr...@re...
+    \item[Web] http://www.revolution-computing.com
+    \end{description}
+    \vspace{1em}
+
+  \end{itemize}
+
+}
+
+% \frame{
+%  \begin{thebibliography}{10}
     
-  \beamertemplatebookbibitems
-  % Start with overview books.
+%  \beamertemplatebookbibitems
+%  % Start with overview books.
 
-  \bibitem{Author1990}
-    A.~Author.
-    \newblock {\em Handbook of Everything}.
-    \newblock Some Press, 1990.
+%  \bibitem{Warnes2006}
+%    G.~Warnes.
+%    \newblock {\em Handbook of Everything}.
+%    \newblock Some Press, 1990.
  
     
-  \beamertemplatearticlebibitems
-  % Followed by interesting articles. Keep the list short. 
+%  \beamertemplatearticlebibitems
+%  % Followed by interesting articles. Keep the list short. 
 
-  \bibitem{Someone2000}
-    S.~Someone.
-    \newblock On this and that.
-    \newblock {\em Journal of This and That}, 2(1):50--100,
-    2000.
-  \end{thebibliography}
-\end{frame}
+%  \bibitem{Someone2000}
+%    S.~Someone.
+%    \newblock On this and that.
+%    \newblock {\em Journal of This and That}, 2(1):50--100,
+%    2000.
+%  \end{thebibliography}
+%
+% }
 
-
 \end{document}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [970] trunk/ssize/inst/doc/ssize.Rnw

[<wa...@us...>]

Revision: 970
Author:   warnes
Date:     2006-07-24 14:23:26 -0700 (Mon, 24 Jul 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=970&view=rev

Log Message:
-----------
Put into RNews format.

Modified Paths:
--------------
    trunk/ssize/inst/doc/ssize.Rnw
Modified: trunk/ssize/inst/doc/ssize.Rnw
===================================================================
--- trunk/ssize/inst/doc/ssize.Rnw	2006-06-29 18:11:22 UTC (rev 969)
+++ trunk/ssize/inst/doc/ssize.Rnw	2006-07-24 21:23:26 UTC (rev 970)
@@ -4,29 +4,24 @@
 %\VignettePackage{ssize}
 
 
-\documentclass[12pt]{article}
-\usepackage{url}
-\usepackage{amsmath}
-\usepackage{natbib}
+%\documentclass[letter]{report}
+\documentclass[a4paper]{report}
+\usepackage{/Library/Frameworks/R.framework/Resources/share/texmf/Sweave}
+\usepackage{Rnews}
+\usepackage[round]{natbib}
 
-
-\newcommand{\Robject}[1]{{\texttt{#1}}}
-\newcommand{\Rfunction}[1]{{\texttt{#1}}}
-\newcommand{\Rpackage}[1]{{\textit{#1}}}
-\newcommand{\Rclass}[1]{{\textit{#1}}}
-\newcommand{\Rmethod}[1]{{\textit{#1}}}
-\newcommand{\code}[1]{\texttt{#1}}
-
 \begin{document}
+\begin{article}
 
 \title{Sample Size Estimation for Microarray Experiments Using the
-	\code{ssize} package.}
+        \code{ssize} package.}
 \author{Gregory R. Warnes \\ 
-        email:\code{gre...@pf...}}
+        email:\code{wa...@bs...}}
+\subtitle{ ~ }
 
 \maketitle
 
-\begin{abstract}
+\section*{abstract}
 
 RNA Expression Microarray technology is widely applied in biomedical
 and pharmaceutical research.  The huge number of RNA concentrations
@@ -39,20 +34,19 @@
 the Bioconductor project (\url{http://www.bioconductor.org}) web
 site.
 
-\end{abstract}
+\section*{Note}
 
-\section{Note}
-
 This document is a simplified version of the manuscript 
 \begin{quote}
-  Warnes, G. R., Liu, P. (2005)
-  Sample Size Estimation for Microarray Experiments, \emph{submitted
-  to} {\it Biometrics}.
+  Warnes, G. R., Liu, P. (2006) Sample Size Estimation for Microarray
+  Experiments, Technical Report, Department of Biostatisticsa and
+  Computational Biology, University of Rochester.
 \end{quote}
-Please refer to that document for a detailed discussion of the
-sample size estimation method.
+which has been available as a pre-publication manuscript since 2004.
+Please refer to that document for a detailed discussion of the sample
+size estimation method.
 
-\section{Introduction}
+\section*{Introduction}
 
 High-throughput microarray experiments allow the measurement of
 expression levels for tens of thousands of genes simultaneously.
@@ -72,9 +66,9 @@
 essential to take into account multiple testing and dependency among
 variables when calculating sample size.  
 
-\section{Method}
+\section*{Method}
 
-\subsection{Overview}
+\subsection*{Overview}
 
 \citet{Warnes05} provides a simple method for computing sample size
 for micrarray experiments, and reports on a sereies of simulations
@@ -89,7 +83,7 @@
 exceptionally valuable in helping scientific clients to make the
 difficult trade offs between experiment cost and statistical power.
 
-\subsection{Assumptions}
+\subsection*{Assumptions}
 
 In the current implementation, we assume that a microarray
 experiment is set up to compare gene expressions between one
@@ -112,7 +106,7 @@
 where $\mu_{T}$ and $\mu_{C}$ are means of gene expressions for
 treatment and control group respectively.
 
-\subsection{Computations}
+\subsection*{Computations}
 
 The proposed procedure to estimate sample size is:
 
@@ -178,7 +172,7 @@
 \ref{fig:CumFoldChangePlot}.
 
 
-\section{Example}
+\section*{Example}
 
 First, we need to load the \code{ssize} library:
 
@@ -186,6 +180,7 @@
 library(ssize)
 library(xtable)
 library(gdata) # for nobs()
+options(width=30)
 @
 
 As part of the \code{ssize} library, I've provided an example data
@@ -196,39 +191,41 @@
 
 <<>>=
 data(exp.sd)
-str(exp.sd)
+#str(exp.sd)
 @ 
 
 This data was calculated via something like
 
 \begin{verbatim}
 library(affy)
-setwd("/data/rstat-data/Standard_Affymetrix_Analysis/GT_methods_050316/WORK")
+setwd("~/GT_methods_050316/WORK")
 load("probeset_data.Rda")
 expression.values <- exprs(probeset.data)
 covariate.data <- pData(probeset.data)
-controls <- expression.values[,covariate.data$GROUP=="Control"] #$
+controls <- expression.values[,
+            covariate.data$GROUP=="Control"] #$
 exp.sd <- apply(controls, 1, sd) 
 \end{verbatim} 
 
 
 Lets see what the distribution looks like:
 
-\begin{figure}[h!]
-  \centering
-  \caption{Distribution of exp.sd}
-  \label{exp.sd.hist}
-<<fig=TRUE,width=12,height=6>>=
-     hist(exp.sd,n=20, col="cyan", border="blue", main="",
-          xlab="Standard Deviation (for data on the log scale)")
+%\begin{figure}[h!]
+%  \centering
+%  \caption{Distribution of exp.sd}
+%  \label{exp.sd.hist}
+%\end{figure}
+
+<<fig=TRUE,width=12,height=12>>=
+     xlab <- c("Standard Deviation", " (for data on the log scale)")
+     hist(exp.sd,n=20, col="cyan", border="blue", main="", xlab=xlab)
      dens <- density(exp.sd)
-     lines(dens$x, dens$y*par("usr")[4]/max(dens$y),col="red",lwd=2) #$
-     title("Histogram of Standard Deviations (log2 scale)")
+     scaled.y <- dens$y*par("usr")[4]/max(dens$y) 
+     lines(dens$x,scaled.y ,col="red",lwd=2) #$
+     title("Histogram of Standard Deviations")
 @  
-\end{figure}
-\begin{center}
-\end{center}
 
+
 Note that this distribution is right skewed, even though it is on
 the $\log_2$ scale.
 
@@ -241,24 +238,29 @@
 @ 
 
 There are 6 functions available in the \code{ssize} package.  
-<<eval=FALSE>>=
-?pow
-@ 
 
 \begin{verbatim}
-     pow(sd, n, delta, sig.level, alpha.correct = "Bonferonni")
-     power.plot(x, xlab = "Power", ylab = "Proportion of Genes with Power >= x", 
-         marks = c(0.7, 0.8, 0.9), ...)
+ pow(sd, n, delta, sig.level, 
+   alpha.correct = "Bonferonni")
+ power.plot(x, xlab = "Power", 
+   ylab = "Proportion of Genes with"
+          " Power >= x", 
+   marks = c(0.7, 0.8, 0.9), ...)
 
-     ssize(sd, delta, sig.level, power, alpha.correct = "Bonferonni")
-     ssize.plot(x, xlab = "Sample Size (per group)",
-                ylab = "Proportion of Genes Needing Sample Size <= n",
-                marks = c(2, 3, 4, 5, 6, 8, 10, 20), ...)
+ ssize(sd, delta, sig.level, power, 
+   alpha.correct = "Bonferonni")
+ ssize.plot(x, 
+   xlab = "Sample Size (per group)",
+   ylab = "Proportion of Genes Needing Sample"
+          " Size <= n",
+   marks = c(2, 3, 4, 5, 6, 8, 10, 20), ...)
 
-     delta(sd, n, power, sig.level, alpha.correct = "Bonferonni")
-     delta.plot (x, xlab = "Fold Change",
-                 ylab = "Proportion of Genes with Power >= 80\% at Fold Change=delta",
-                 marks = c(1.5, 2, 2.5, 3, 4, 6, 10), ...) 
+ delta(sd, n, power, sig.level, 
+   alpha.correct = "Bonferonni")
+ delta.plot (x, xlab = "Fold Change",
+   ylab = "Proportion of Genes with "
+          "Power >= 80\% at Fold Change=delta",
+   marks = c(1.5, 2, 2.5, 3, 4, 6, 10), ...) 
 \end{verbatim}
 
 You will note that there are three pairs.  
@@ -297,10 +299,7 @@
 \item What is the power for 6 patients per group with  $\delta=1.0$,
  $\alpha=0.05$?
 
-\begin{figure}[h!]
-  \caption{Effect of Sample Size on Power} \label{fig:CumNPlot}
-  \centering
-<<fig=TRUE,width=12,height=6>>=
+<<fig=TRUE,width=12,height=12>>=
 all.power <- pow(sd=exp.sd, n=n, delta=log2(fold.change),
                  sig.level=sig.level)
 
@@ -314,18 +313,16 @@
        xjust=1, yjust=1, cex=1.0)
 title("Power to Detect 2-Fold Change")
 @  
-\end{figure}
+%\begin{figure}[h!]
+%  \caption{Effect of Sample Size on Power} \label{fig:CumNPlot}
+%  \centering
+%\end{figure}
 
-
 \item What is the necessary per-group sample size for $80\%$ power
       when $\delta=1.0$, and $\alpha=0.05$?
 
 
-\begin{figure}[h!]
-  \caption{Sample size required to detect a 2-fold treatment effect.}
-  \label{fig:CumPowerPlot}
-  \centering
-<<fig=TRUE,width=12,height=6>>=
+<<fig=TRUE,width=12,height=12>>=
 all.size  <- ssize(sd=exp.sd, delta=log2(fold.change),
                    sig.level=sig.level, power=power)
 ssize.plot(all.size, lwd=2, col="magenta", xlim=c(1,20))
@@ -339,21 +336,27 @@
        xjust=1, yjust=0, cex=1.0)
 title("Sample Size to Detect 2-Fold Change")
 @ 
-\end{figure}
+%\begin{figure}[h!]
+%  \caption{Sample size required to detect a 2-fold treatment effect.}
+%  \label{fig:CumPowerPlot}
+%  \centering
+%\end{figure}
 
-\clearpage
+%\clearpage
 
 \item What is necessary fold change to achieve $80\%$ with  $n=6$
 patients per group, when $\delta=1.0$ and $\alpha=0.05$?
 
-\begin{figure}[h!]
-  \caption[Given Sample Size, Fold Change (Effect Size) Necessary to
-    Achieving a Specified Power]{Given sample size, this plot allows
-    visualization of the fraction of genes achieving the specified
-    power for different fold changes.}
-  \label{fig:CumFoldChangePlot}
-  \centering
-<<fig=TRUE,width=12,height=6>>=
+%\begin{figure}[h!]
+%  \caption[Given Sample Size, Fold Change (Effect Size) Necessary to
+%    Achieving a Specified Power]{Given sample size, this plot allows
+%    visualization of the fraction of genes achieving the specified
+%    power for different fold changes.}
+%  \label{fig:CumFoldChangePlot}
+%  \centering
+%\end{figure}
+
+<<fig=TRUE,width=12,height=12>>=
 all.delta  <- delta(sd=exp.sd, power=power, n=n,
                     sig.level=sig.level)
 delta.plot(all.delta, lwd=2, col="magenta", xlim=c(1,10))
@@ -366,11 +369,10 @@
        xjust=1, yjust=0, cex=1.0)
 title("Fold Change to Achieve 80\% Power")
 @ 
-\end{figure}
 
 \end{enumerate}
 
-\section{Modifications}
+\section*{Modifications}
 
 While the \code{ssize} package has been implemented using the simple
 2-sample pooled t-test, you can easily modify the code for other
@@ -379,13 +381,13 @@
 appropriate computation for the desired experimental design.
 
 
-\section{Future Work}
+\section*{Future Work}
 
 Peng Liu is currently developing methods and code for substituting
 False Discovery Rate for the Bonferonni multiple comparison
 adjustment.
 
-\section{Contributions}
+\section*{Contributions}
 
 Contributions and discussion are welcome.
 
@@ -452,4 +454,6 @@
   653-667.
 
 \end{thebibliography}
+
+\end{article}
 \end{document}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [967] trunk/gplots/R/heatmap.2.R

[<nj...@us...>]

Revision: 967
Author:   nj7w
Date:     2006-06-26 14:08:21 -0700 (Mon, 26 Jun 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=967&view=rev

Log Message:
-----------
Fixed a bug which displayed warnings when Rowv and Colv were specified as dendrograms

Modified Paths:
--------------
    trunk/gplots/R/heatmap.2.R
Modified: trunk/gplots/R/heatmap.2.R
===================================================================
--- trunk/gplots/R/heatmap.2.R	2006-06-06 19:17:08 UTC (rev 966)
+++ trunk/gplots/R/heatmap.2.R	2006-06-26 21:08:21 UTC (rev 967)
@@ -109,6 +109,7 @@
     if(missing(cellnote))
       cellnote <- matrix("", ncol=ncol(x), nrow=nrow(x))
 
+   if(!inherits(Rowv, "dendrogram")) {
   ## Check if Rowv and dendrogram arguments are consistent
   if ( ( (!isTRUE(Rowv)) || (is.null(Rowv))) && (dendrogram %in% c("both","row") ) )
   {
@@ -121,7 +122,9 @@
             dendrogram, "'. Omitting row dendogram.")
     
   }
+}
 
+    if(!inherits(Colv, "dendrogram")) {
  ## Check if Colv and dendrogram arguments are consistent
   if ( ( (!isTRUE(Colv)) || (is.null(Colv)))
       && (dendrogram %in% c("both","column")) )
@@ -134,7 +137,7 @@
     warning("Discrepancy: Colv is FALSE, while dendrogram is `",
             dendrogram, "'. Omitting column dendogram.")
    }
-
+}
   
   
   ## by default order by row/col mean


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [966] trunk/gmodels/man

[<nj...@us...>]

Revision: 966
Author:   nj7w
Date:     2006-06-06 12:17:08 -0700 (Tue, 06 Jun 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=966&view=rev

Log Message:
-----------
Updated ci, estimable and fit.contrast as per Randall Johnson

Modified Paths:
--------------
    trunk/gmodels/man/ci.Rd
    trunk/gmodels/man/estimable.Rd
    trunk/gmodels/man/fit.contrast.Rd
Modified: trunk/gmodels/man/ci.Rd
===================================================================
--- trunk/gmodels/man/ci.Rd	2006-06-05 21:00:28 UTC (rev 965)
+++ trunk/gmodels/man/ci.Rd	2006-06-06 19:17:08 UTC (rev 966)
@@ -18,7 +18,9 @@
   \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}{lme}(x, confidence = 0.95, alpha = 1 - confidence,...)
+  \method{ci}{lmer}(x, confidence = 0.95, alpha = 1 - confidence,
+                    sim.lmer=TRUE, n.sim=1000, ...) 
 }
 \arguments{
   \item{x}{ object from which to compute confidence intervals. }
@@ -27,6 +29,10 @@
   \item{na.rm}{boolean indicating whether missing values should be
     removed. Defaults to \code{FALSE}.}
   \item{\dots}{Arguments for methods}
+  \item{sim.lmer}{Logical value. If TRUE confidence
+    intervals will be estimated using \code{\Link[Matrix]{mcmcsamp}}. This option only takes effect for lmer
+    objects.}
+  \item{n.sim}{Number of samples to take in \code{\Link[Matrix]{mcmcsamp}}.}
 }
 %\details{
 %  ~~ If necessary, more details than the __description__  above ~~

Modified: trunk/gmodels/man/estimable.Rd
===================================================================
--- trunk/gmodels/man/estimable.Rd	2006-06-05 21:00:28 UTC (rev 965)
+++ trunk/gmodels/man/estimable.Rd	2006-06-06 19:17:08 UTC (rev 966)
@@ -2,6 +2,7 @@
 %
 \name{estimable}
 \alias{estimable}
+\alias{estimable.lmer}
 %\alias{.wald}
 %\alias{.to.est}
 \title{Contrasts and estimable linear functions of model coefficients}
@@ -10,6 +11,7 @@
   objects}
 \usage{
 estimable(obj, cm, beta0, conf.int=NULL, joint.test=FALSE, show.beta0)
+\method{estimable}{lmer}(obj, cm, beta0, conf.int = NULL, show.beta0, sim.lmer = TRUE, n.sim = 1000)         %%%%%%%%%%% added this line
 %.wald(obj, cm,beta0=rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm))))
 %.to.est(obj, params)
 }
@@ -28,6 +30,9 @@
    \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.lmer}{Logical value. If TRUE p-values and confidence                 %%%
+     intervals will be estimated using \code{\Link[Matrix]{mcmcsamp}}.}           %%% Added these sections
+   \item{n.sim}{Number of MCMC samples to take in \code{\Link[Matrix]{mcmcsamp}}.}%%%
 }
 \details{
   \code{estimable} computes an estimate, test statitic, significance

Modified: trunk/gmodels/man/fit.contrast.Rd
===================================================================
--- trunk/gmodels/man/fit.contrast.Rd	2006-06-05 21:00:28 UTC (rev 965)
+++ trunk/gmodels/man/fit.contrast.Rd	2006-06-06 19:17:08 UTC (rev 966)
@@ -4,6 +4,7 @@
 \alias{fit.contrast}
 \alias{fit.contrast.lm}
 \alias{fit.contrast.lme}
+\alias{fit.contrast.lmer}
 \title{Compute and test arbitrary contrasts for regression objects}
 \description{
  Compute and test arbitrary contrasts for regression objects.
@@ -14,6 +15,8 @@
              conf.int=NULL, df=FALSE, ...)
 \method{fit.contrast}{lme}(model, varname, coeff, showall=FALSE,
              conf.int=NULL, df=FALSE, ...)
+\method{fit.contrast}{lmer}(model, varname, coeff, showall=FALSE,
+             conf.int=NULL, sim.lmer = TRUE, n.sim = 1000, ...)
 }
 \arguments{
   \item{model}{regression (lm,glm,aov,lme) object for which the
@@ -31,6 +34,10 @@
   \item{df}{boolean indicating whether to return a column containing the
     degrees of freedom.}
   \item{\dots}{optional arguments provided by methods.}
+  \item{sim.lmer}{Logical value. If TRUE p-values and confidence
+    intervals will be estimated using \code{\Link[Matrix]{mcmcsamp}}. This option only takes effect for lmer
+    objects.}
+  \item{n.sim}{Number of samples to use in \code{\Link[Matrix]{mcmcsamp}}.}
   }
   
 \details{


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [964] trunk/gmodels/R

[<nj...@us...>]

Revision: 964
Author:   nj7w
Date:     2006-06-05 13:59:50 -0700 (Mon, 05 Jun 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=964&view=rev

Log Message:
-----------
Additions as per Randall C Johnson

Modified Paths:
--------------
    trunk/gmodels/R/ci.R
    trunk/gmodels/R/estimable.R
    trunk/gmodels/R/fit.contrast.R
    trunk/gmodels/R/to.est.R
Modified: trunk/gmodels/R/ci.R
===================================================================
--- trunk/gmodels/R/ci.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/ci.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -67,19 +67,19 @@
   retval
 }
 
-ci.lmer <- function(x,confidence=0.95,alpha=1-confidence,...)
-  {
-  est  <-  fixef(x)
-  se <- sqrt(diag(vcov(x)))
-  df <- getFixDF(x)
-  ci.low  <- est + qt(alpha/2, df) * se
-  ci.high <- est - qt(alpha/2, df) * se
-  retval  <- cbind(Estimate=est,
-                   "CI lower"=ci.low,
-                   "CI upper"=ci.high,
-                   "Std. Error"= se,
-                   "DF" = df,
-                   "p-value" = 2*(1-pt(abs(est/se), df)))
-  rownames(retval)  <-  names(est)
+ci.lmer <- function(x, confidence=0.95, alpha=1-confidence, sim.lmer=TRUE, n.sim=1000, ...) ################### changed this function
+{
+  if(!(require(coda, quietly=TRUE) & require(Matrix, quietly=TRUE)))
+    stop("coda and Matrix packages required for ci.lmer")
+  
+  x.effects <- fixef(x)
+  n <- length(x.effects)
+
+  retval <- est.lmer(obj = x, cm = diag(n), beta0 = rep(0, n),
+                     conf.int = confidence, show.beta0 = FALSE,
+                     n.sim = n.sim)[,c("Estimate", "Lower.CI", "Upper.CI", "Std. Error", "p value")]
+
+  colnames(retval)[c(2:3, 5)] <- c("CI lower", "CI upper", "p-value")
+  rownames(retval) <- names(x.effects)
   retval
 }

Modified: trunk/gmodels/R/estimable.R
===================================================================
--- trunk/gmodels/R/estimable.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/estimable.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -9,12 +9,11 @@
     }
   else if(is.list(cm))
     {
-      cm <- t(sapply(cm,
-                     .to.est, obj=obj)) 
-    }
+      cm <- matrix(.to.est(obj, cm), nrow=1) ################### changed 
+    }                                        ################### it seems that the names are lost with the way it used to be...
   else if(is.vector(cm))
     {
-      cm <- matrix(.to.est(obj, cm),nrow=1)
+      cm <- matrix(.to.est(obj, cm), nrow=1)
     }
   else
     {
@@ -43,24 +42,8 @@
     }
   else
     {
-      if ("lmer" %in% class(obj)) {
+      if ("lme" %in% class(obj)) {
         stat.name <- "t.stat"
-        cf <- as.matrix(fixef(obj))
-        vcv <- vcov(obj)
-        tmp <- cm
-        tmp[tmp==0] <- NA
-        df.all <- t(abs(t(tmp) * getFixDF(obj)))
-        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 fredom vary among parameters used to ",
-                        "constrct linear contrast(s): ",
-                        paste((1:nrow(tmp))[problem], collapse=", "),
-                        ". Using the smallest df among the set of parameters.",
-                        sep=""))
-      }
-      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])
@@ -113,7 +96,7 @@
         }
       else
         {
-          stop("obj must be of class 'lm', 'glm', 'aov', 'lme', 'lmer', 'gee', 'geese' or 'nlme'")
+          stop("obj must be of class 'lm', 'glm', 'aov', 'lme', 'gee', 'geese' or 'nlme'")
         }
       if (is.null(cm))
         cm <- diag(dim(cf)[1])
@@ -136,7 +119,7 @@
              },
              X2.stat={
                prob <- 1 - pchisq((ct.diff/vc)^2, df=1)
-             })
+             })                                                      ##################
 
       if (stat.name=="X2.stat")
         {
@@ -153,17 +136,19 @@
           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)
-          })
+          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)
@@ -212,15 +197,65 @@
     print(as.data.frame(retval))
 }
 
+estimable.lmer <- function (obj, cm, beta0, conf.int=NULL,
+                            show.beta0, sim.lmer=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.")
+    }
 
-## this is how the DF are caclulated in the Matrix package (for lmer.summary objects)
-## it seems that this is not entirely correct, but will hopfully be improved upon shortly
-## see lmer.R from the Matrix package version 0.99-1
+  if(missing(show.beta0))
+    {
+      if(!missing(beta0))
+        show.beta0=TRUE
+      else
+        show.beta0=FALSE
+    }
 
-getFixDF <- function(obj)
-{
-          nc <- obj@nc[-seq(along = obj@Omega)]
-          p <- abs(nc[1]) - 1
-          n <- nc[2]
-          rep(n-p, p)
+
+  if (missing(beta0))
+    {
+      beta0 = rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm)))
+
+    }
+
+    if ("lmer" %in% class(obj)) {                                      
+      if(!require(Matrix, quietly=TRUE))                               
+        stop("Matrix package required for lmer objects")               
+                                                                       
+      if(sim.lmer)                                                     
+        return(est.lmer(obj=obj, cm=cm, beta0=beta0, conf.int=conf.int,
+                        show.beta0=show.beta0, n.sim=n.sim))           
+                                                                       
+      stat.name <- "lmer"                                              
+      cf <- as.matrix(fixef(obj))                                      
+      vcv <- as.matrix(vcov(obj))                                      
+      df <- NA                                                         
+    }
+    else {
+      stop("obj is not of class lmer")
+    }
+
+    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)
+
 }

Modified: trunk/gmodels/R/fit.contrast.R
===================================================================
--- trunk/gmodels/R/fit.contrast.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/fit.contrast.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -4,9 +4,9 @@
                             conf.int=NULL, df=FALSE, ...)
 {
   # check class of model
-  if( !(any(class(model) %in% c("lm", "aov", "lme", "lmer") ) ))
-    stop("contrast.lm can only be applied to objects inheriting from 'lm'",
-         "and 'lme' (eg: lm,glm,aov,lme,lmer).")
+  if( !(any(class(model) %in% c("lm", "aov", "lme") ) ))                        ######
+    stop("contrast.lm can only be applied to objects inheriting from 'lm'",     ###### took lmer out of here
+         "and 'lme' (eg: lm,glm,aov,lme).")                                     ######
 
   # make sure we have the NAME of the variable
   if(!is.character(varname))
@@ -34,10 +34,7 @@
   colnames(cmat) <- cn
 
   # recall fitting method with the specified contrast
-  if(!("lmer" %in% class(model)))
-     m <- model$call
-  else
-     m <- model@call # lmer is class 4
+  m <- model$call                                     ###### deleted lmer specific/S4 portion
 
   if(is.null(m$contrasts))
     m$contrasts <- list()
@@ -49,23 +46,8 @@
     r <- eval(m)
 
   # now return the correct elements ....
-  if( 'lmer' %in% class(model) )
+  if( 'lme' %in% class(model) )              ####### took out lmer section
     {
-      est <- fixef(r) 
-      se  <- sqrt(diag(vcov(r)))
-      tval <- est/se
-      df.lmer   <- getFixDF(r)
-      retval <- cbind(
-                      "Estimate"= est,
-                      "Std. Error"= se,
-                      "t-value"= tval,
-                      "Pr(>|t|)"=  2 * (1 - pt(abs(tval), df.lmer)),
-                      "DF"=df.lmer
-                      )
-
-    }
-  else if( 'lme' %in% class(model) )
-    {
       est <- r$coefficients$fixed
       se  <- sqrt(diag(r$varFix))
       tval <- est/se
@@ -99,10 +81,7 @@
         }
       else
         {
-          if(!("lmer" %in% class(model))) # doesn't add this on in lmer
-            rn <- paste(varname,rownames(coeff),sep="")
-          else
-            rn <- varname
+          rn <- paste(varname,rownames(coeff),sep="")       ####### removed lmer portion
           ind <- match(rn,rownames(retval))
           retval <- retval[ind,,drop=FALSE]
         }
@@ -138,14 +117,89 @@
     fit.contrast.lm(model, varname, coeff, showall, conf.int, df)
   }
 
+# I made rather dramatic changes here and do all calculations in fit.contrast.lmer rather than
+# fit.contrast.lm because of the simulation extras ... added sim.lmer and n.sim to the parameter list
 fit.contrast.lmer <- function(model, varname, coeff, showall=FALSE,
-                            conf.int=NULL, df=FALSE, ...)
+                            conf.int=NULL, sim.lmer=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.lmer)
   {
-    require(lme4)
-    fit.contrast.lm(model, varname, coeff, showall, conf.int, df)
+    retval <- est.lmer(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 lmer objects requires simulation -- use sim.lmer = 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")
 

Modified: trunk/gmodels/R/to.est.R
===================================================================
--- trunk/gmodels/R/to.est.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/to.est.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -45,7 +45,10 @@
                   )
         }
 
-      est[names(params)] <- params
+      if(is.list(params))                      #####################
+        est[names(params)] <- unlist(params)   ##################### changed
+      else                                     #####################
+        est[names(params)] <- params           #####################
     }
 
   return(est)


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [965] trunk/gmodels/DESCRIPTION

[<nj...@us...>]

Revision: 965
Author:   nj7w
Date:     2006-06-05 14:00:28 -0700 (Mon, 05 Jun 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=965&view=rev

Log Message:
-----------
Additions as per Randall C Johnson

Modified Paths:
--------------
    trunk/gmodels/DESCRIPTION
Modified: trunk/gmodels/DESCRIPTION
===================================================================
--- trunk/gmodels/DESCRIPTION	2006-06-05 20:59:50 UTC (rev 964)
+++ trunk/gmodels/DESCRIPTION	2006-06-05 21:00:28 UTC (rev 965)
@@ -1,6 +1,6 @@
 Package: gmodels
-Version: 2.12.0
-Date: 2005-12-03
+Version: 2.12.0-3
+Date: 2006-04-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.
@@ -16,4 +16,4 @@
 	 Contract NO1-CO-12400.
 URL: http://cran.r-project.org/src/contrib/PACKAGES.html 
      http://www.sf.net/projects/r-gregmisc
-
+Packaged: Mon Jun  5 16:19:14 2006; root


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [963] trunk/gmodels/R/est.lmer.R

[<nj...@us...>]

Revision: 963
Author:   nj7w
Date:     2006-06-05 13:57:17 -0700 (Mon, 05 Jun 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=963&view=rev

Log Message:
-----------
- New function to estimate CI's and p-values using mcmcsamp() from the
Matrix package

Added Paths:
-----------
    trunk/gmodels/R/est.lmer.R
Added: trunk/gmodels/R/est.lmer.R
===================================================================
--- trunk/gmodels/R/est.lmer.R	                        (rev 0)
+++ trunk/gmodels/R/est.lmer.R	2006-06-05 20:57:17 UTC (rev 963)
@@ -0,0 +1,64 @@
+# est.lmer.R
+# generate estimable output for lmer objects using mcmcsamp()
+# Randall Johnson
+# Laboratory of Genomic Diversity at NCI Frederick
+# SAIC Frederick, Inc
+# Created April 25, 2006
+
+est.lmer <- function(obj, cm, beta0, conf.int, show.beta0, n.sim)
+{
+  if(!require(coda, quietly=TRUE))
+    stop("coda package required when sim.lmer == TRUE")
+
+  samp <- mcmcsamp(obj, n.sim)
+  samp.summ <- summary(samp)
+
+  if(is.null(dim(cm)))
+    n <- length(cm)
+  else
+    n <- dim(cm)[2]
+                               # drop extra information on end
+  samp.cm <- as.matrix(samp)[, 1:n] %*% t(cm)
+
+  # calculate requested statistics
+  est <- drop(cm %*% samp.summ$statistics[1:n,1])
+  stderr <- sd(samp.cm)
+  
+  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[2,]
+    upper.ci <- samp.ci[1,]
+  }
+
+  # 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)
+}
+
+percentile <- function(x, distn)
+{
+  n <- length(distn)
+    
+  return(findInterval(x, distn[order(distn)]) / n)
+}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [959] trunk/gmodels/R

[<nj...@us...>]

Revision: 959
Author:   nj7w
Date:     2006-05-05 11:29:44 -0700 (Fri, 05 May 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=959&view=rev

Log Message:
-----------
Fixed an error: According to Marc Schwartz - there was an error when a matrix without dimnames(or names(dimnames)) was passed as x argument

Modified Paths:
--------------
    trunk/gmodels/R/CrossTable.R
    trunk/gmodels/man/CrossTable.Rd
Modified: trunk/gmodels/R/CrossTable.R
===================================================================
--- trunk/gmodels/R/CrossTable.R	2006-05-05 18:13:57 UTC (rev 958)
+++ trunk/gmodels/R/CrossTable.R	2006-05-05 18:29:44 UTC (rev 959)
@@ -1,3 +1,9 @@
+# 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()
@@ -18,7 +24,7 @@
                         prop.r = TRUE,
                         prop.c = TRUE,
                         prop.t = TRUE,
-                        prop.chisq=TRUE,
+                        prop.chisq = TRUE,
                         chisq = FALSE,
                         fisher = FALSE,
                         mcnemar = FALSE,
@@ -26,7 +32,7 @@
                         sresid = FALSE,
                         asresid = FALSE,
                         missing.include = FALSE,
-                        format=c("SAS","SPSS"),
+                        format = c("SAS", "SPSS"),
                         dnn = NULL,
                         ...
                         )
@@ -67,8 +73,20 @@
           if(any(x < 0) || any(is.na(x)))
             stop("all entries of x must be nonnegative and finite")
 
-          ## Add generic dimnames if required
-          ## check each dimname separately, in case user has defined one or the other
+          ## 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)))
@@ -272,7 +290,7 @@
                     digits = digits, format = "f",
                             width = CWidth-1), sep="  | ", collapse=""),
                 cat(SpaceSep2, sep = " | ", collapse = "\n"), sep="", collapse="")
-      if (prop.r)
+          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"),

Modified: trunk/gmodels/man/CrossTable.Rd
===================================================================
--- trunk/gmodels/man/CrossTable.Rd	2006-05-05 18:13:57 UTC (rev 958)
+++ trunk/gmodels/man/CrossTable.Rd	2006-05-05 18:29:44 UTC (rev 959)
@@ -1,3 +1,9 @@
+%% 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()


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [958] trunk/gtools/man/combinations.Rd

[<nj...@us...>]

Revision: 958
Author:   nj7w
Date:     2006-05-05 11:13:57 -0700 (Fri, 05 May 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=958&view=rev

Log Message:
-----------
Fixed minor typo - in {value} - n was replaced by r

Modified Paths:
--------------
    trunk/gtools/man/combinations.Rd
Modified: trunk/gtools/man/combinations.Rd
===================================================================
--- trunk/gtools/man/combinations.Rd	2006-05-05 16:55:31 UTC (rev 957)
+++ trunk/gtools/man/combinations.Rd	2006-05-05 18:13:57 UTC (rev 958)
@@ -33,7 +33,7 @@
   \code{options} command for details on how to do this.
 }
 \value{
-  Returns a matrix where each row contains a vector of length \code{n}.
+  Returns a matrix where each row contains a vector of length \code{r}.
 }
 \references{Venables, Bill.  "Programmers Note", R-News, Vol 1/1,
   Jan. 2001. \url{http://cran.r-project.org/doc/Rnews} }


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [957] trunk/gtools

[<nj...@us...>]

Revision: 957
Author:   nj7w
Date:     2006-05-05 09:55:31 -0700 (Fri, 05 May 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=957&view=rev

Log Message:
-----------
Fixed minor typos

Modified Paths:
--------------
    trunk/gtools/NAMESPACE
    trunk/gtools/man/capture.Rd
Modified: trunk/gtools/NAMESPACE
===================================================================
--- trunk/gtools/NAMESPACE	2006-04-20 20:54:09 UTC (rev 956)
+++ trunk/gtools/NAMESPACE	2006-05-05 16:55:31 UTC (rev 957)
@@ -3,6 +3,7 @@
 export(
        addLast,
        assert,
+       capture,
        combinations,
        ddirichlet,
        defmacro,
@@ -23,6 +24,7 @@
        running,
        scat,
        setTCPNoDelay,
+       sprint,
        strmacro
        )
 

Modified: trunk/gtools/man/capture.Rd
===================================================================
--- trunk/gtools/man/capture.Rd	2006-04-20 20:54:09 UTC (rev 956)
+++ trunk/gtools/man/capture.Rd	2006-05-05 16:55:31 UTC (rev 957)
@@ -1,7 +1,7 @@
 \name{capture}
 \alias{capture}
 \alias{sprint}
-\title{Capture printed output of an R expression in a string}.
+\title{Capture printed output of an R expression in a string}
 \description{ 
 Capture printed output of an R expression in a string
 }


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [956] trunk/gregmisc/gregmisc/DESCRIPTION.in

[<nj...@us...>]

Revision: 956
Author:   nj7w
Date:     2006-04-20 13:54:09 -0700 (Thu, 20 Apr 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=956&view=rev

Log Message:
-----------
 Changed the typ of Backword to Backward

Modified Paths:
--------------
    trunk/gregmisc/gregmisc/DESCRIPTION.in
Modified: trunk/gregmisc/gregmisc/DESCRIPTION.in
===================================================================
--- trunk/gregmisc/gregmisc/DESCRIPTION.in	2006-04-03 15:44:53 UTC (rev 955)
+++ trunk/gregmisc/gregmisc/DESCRIPTION.in	2006-04-20 20:54:09 UTC (rev 956)
@@ -1,6 +1,6 @@
 Package: gregmisc
-Title: Backword compatibility package for gregmisc bundle
-Description: Backword compatibility package for gregmisc bundle.  This package
+Title: Backward compatibility package for gregmisc bundle
+Description: Backward compatibility package for gregmisc bundle.  This package
              simply loads the other packages within the gregmisc bundle, in
 	     in order to simulate the old behavior when gregmisc was a single
              package.


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [955] trunk/PathwayModeling/thesispaper

[<r_b...@us...>]

Revision: 955
Author:   r_burrows
Date:     2006-04-03 08:44:53 -0700 (Mon, 03 Apr 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=955&view=rev

Log Message:
-----------
separate pages: initial commit

Added Paths:
-----------
    trunk/PathwayModeling/thesispaper/table1.Snw
    trunk/PathwayModeling/thesispaper/table2.Snw
Added: trunk/PathwayModeling/thesispaper/table1.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/table1.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/table1.Snw	2006-04-03 15:44:53 UTC (rev 955)
@@ -0,0 +1,25 @@
+\begin{table}
+ \begin{center}
+    \caption{Rate constants used in the Gillespie simulator}
+    \begin{tabular}{c|r}
+      rate constant & value \\
+      \hline
+      $k_1$ & 1.600 \\
+      $k_2$ & 0.540 \\
+      $k_3$ & 19.500 \\
+      $k_4$ & 2.125 \\
+      $k_5$ & 0.190 \\
+      $k_6$ & 8.460 \\
+      $k_7$ & 2.077 \\
+      $k_8$ & 0.090 \\
+      $k_9$ & 4.560 \\
+      $k_{10}$ & 1.400 \\
+      $k_{11}$ & 0.106 \\
+      $k_{12}$ & 3.670 \\
+      $k_{13}$ & 1.640 \\
+      $k_{14}$ & 0.400 \\
+      \hline
+    \end{tabular}
+    \label{ki}
+  \end{center}
+\end{table}

Added: trunk/PathwayModeling/thesispaper/table2.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/table2.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/table2.Snw	2006-04-03 15:44:53 UTC (rev 955)
@@ -0,0 +1,17 @@
+\begin{table}
+  \begin{center}
+    \caption{Mean squared residuals}
+    \begin{tabular}{c||c|c|c||c|c|c}
+       &
+       \multicolumn{3}{c||}{mean residual SSQ $\times 10^{-4}$} & \multicolumn{3}{c}{$R_{adj}^2$}\\
+      \cline{2-7}
+      algorithm & 12 pt. & 16 pt. & 25 pt. &
+      12 pt. & 16 pt. & 25 pt.\\
+      \hline
+       1-comp & 1.34 & 0.83 & 1.06 & 0.87 & 0.92 & 0.86\\
+       all-comp & 0.74 & 0.93 & 0.74 & 0.93 & 0.90 & 0.90 \\
+       NKC & 0.86 & 0.73 & 0.71 & 0.92 & 0.92 & 0.91
+    \end{tabular}
+    \label{MSq}
+  \end{center}
+\end{table}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [954] trunk/PathwayModeling/thesispaper

[<r_b...@us...>]

Revision: 954
Author:   r_burrows
Date:     2006-04-03 08:41:40 -0700 (Mon, 03 Apr 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=954&view=rev

Log Message:
-----------
separate pages: initial commit

Added Paths:
-----------
    trunk/PathwayModeling/thesispaper/figure3.Snw
    trunk/PathwayModeling/thesispaper/figure4.Snw
    trunk/PathwayModeling/thesispaper/figure5.Snw
    trunk/PathwayModeling/thesispaper/figure6.Snw
    trunk/PathwayModeling/thesispaper/figure7.Snw
    trunk/PathwayModeling/thesispaper/figure8.Snw
Added: trunk/PathwayModeling/thesispaper/figure3.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure3.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure3.Snw	2006-04-03 15:41:40 UTC (rev 954)
@@ -0,0 +1,18 @@
+    \begin{figure}
+      \centering
+      \subfloat[1-component]{\includegraphics[scale=0.50]{figures/1comp}
+      \label{1comp}}
+      \qquad
+      \subfloat[all-components]{\includegraphics[scale=0.50]{figures/allcomp}
+      \label{allComp}}
+      \qquad
+      \subfloat[NKC]{\includegraphics[scale=0.50]{figures/nkc}\label{nkc}}
+      \caption[Movement of Markov chains with the
+       Metropolis algorithms]{Movement of Markov chains with the component-wise and
+      all-components Metropolis algorithms. Movement in a
+      2-dimensional space is illustrated, so each point has 2
+      components. The dotted lines are contours of equal probability
+      density for the proposal distributions and the dashed lines are
+      probabilty contours of the target distribution.}
+      \label{1comp_vs_all}
+    \end{figure}

Added: trunk/PathwayModeling/thesispaper/figure4.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure4.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure4.Snw	2006-04-03 15:41:40 UTC (rev 954)
@@ -0,0 +1,40 @@
+<<fig4,echo=F,eval=F>>=3
+source("R/paperSSQ.R")
+source("R/getModes.R")
+source("R/do.optim.R")
+source("R/plotDensities.R")
+output16 <- read.table("data/output16.AllComp.thinned")
+input16 <- read.table("data/input16.dat", header=T)
+attach(input16)
+temp<-output16[sample(1:20000,5000),]
+temp2<-numeric(5000)
+for (i in 1:5000) temp2[i]<-paperSSQ(temp[i,])
+temp<-temp[order(temp2),]
+write.table(temp[1:4750,],file="figures/tempDir/Dsamp.dat",row.names=F,col.names=F)
+mcmcML <- as.numeric(temp[1,-10])
+write.table(mcmcML,file="figures/tempDir/mcmcML.dat",row.names=F,col.names=F)
+modes<-getModes(output16)
+temp<-do.optim(start=modes[-10],scail=modes[-10])
+temp<-do.optim(start=temp$par,scail=temp$par)
+optimML<-temp$par
+write.table(optimML,file="figures/tempDir/optimML.dat",row.names=F,col.names=F)
+SD <- numeric(9)
+for (i in 1:9) SD[i] <- sd(output16[,i])
+pdf(file="figures/tempDir/densities.pdf",width=6,height=6)
+par(mfrow=c(3,3))
+plotDensities(output16)
+dev.off()
+par(mfrow=c(1,1))
+detach(input16)
+@
+\begin{figure}
+  \centering
+  \includegraphics[scale=0.8]{figures/tempDir/densities}
+  \caption[Histograms of the marginal probability distributions]{Histograms of the marginal probability distributions for
+  the 5-reaction model generated with the all-components Metropolis
+  algorithm and the 16-point dataset. The curves are normal densities with means equal to the
+  medians of the distributions and variances equal to the variances of
+  the distributions. \textit{Red vertical lines indicate the parameters values that 
+  minimize the mean squared residuals.}}
+  \label{densities}
+\end{figure}

Added: trunk/PathwayModeling/thesispaper/figure5.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure5.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure5.Snw	2006-04-03 15:41:40 UTC (rev 954)
@@ -0,0 +1,22 @@
+<<fig5,echo=F,eval=F>>=4
+source("R/plotDensity.R")
+source("R/plotConverged.R")
+output12 <- read.table("data/output12.AllComp.thinned")
+output16 <- read.table("data/output16.AllComp.thinned")
+output25 <- read.table("data/output25.AllComp.thinned")
+pdf(file="figures/tempDir/converged.pdf",width=6,height=6)
+par(mfrow=c(3,3))
+plotConverged()
+dev.off()
+par(mfrow=c(1,1))
+@
+\begin{figure}
+  \centering
+  \includegraphics[scale=0.9]{figures/tempDir/converged}
+  \caption{\textit{Posterior distributions from different numbers} of data
+  points for the all-components algorithm. (---------) prior
+  distribution; ({\color{red} - - - -}) 12 points; ({\color{green}
+  $\cdots\cdots$}) 16 points; ({\color{blue} -- $\cdot$ -- $\cdot$ --}) 25
+  points}
+  \label{converged}
+\end{figure}

Added: trunk/PathwayModeling/thesispaper/figure6.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure6.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure6.Snw	2006-04-03 15:41:40 UTC (rev 954)
@@ -0,0 +1,25 @@
+<<fig6, echo=F,eval=F>>=5
+source("R/paperPairs.R")
+mcmcML <-scan("figures/tempDir/mcmcML.dat")
+output16 <- read.table("data/output16.AllComp.thinned")
+mcmc.cor <- function(x,y) {
+    par(usr=c(0,1,0,1))
+    r <- cor(x,y)
+    txt <- format(r,digits=2)
+    text(0.5,0.5,txt,cex=1.4)
+    }
+pdf(file="figures/tempDir/scatterPlot.pdf",width=8,height=8)
+par(pch='.')
+paperPairs(output16[sample(1:20000,2000),-10],labels=c('d1','d2','d3','d4','d5','d6','d7','d8','d9'),lower.panel=mcmc.cor)
+dev.off()
+par(pch=1)
+@
+\begin{figure}
+  \centering
+  \includegraphics[scale=0.6]{figures/tempDir/scatterPlot}
+  \caption[Bivariate scatter plots of the parameter distributions]{Bivariate scatter plots of the parameter distributions for
+  the 5-reaction model found with the all-components Metropolis
+  algorithm (upper triangle); correlation coefficients (lower
+  triangle). The red lines indicate the maximum likelihood estimates of the parameters.}
+  \label{scatter}
+\end{figure}

Added: trunk/PathwayModeling/thesispaper/figure7.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure7.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure7.Snw	2006-04-03 15:41:40 UTC (rev 954)
@@ -0,0 +1,28 @@
+<<fig7, echo=F, eval=F>>=6
+source("R/paperSSQ.R")
+source("R/getModes.R")
+source("R/do.optim.R")
+source("R/fitPaper.R")
+source("R/get95CI.R")
+source("R/plotVi.R")
+mcmcML <-scan("figures/tempDir/mcmcML.dat")
+optimML <-scan("figures/tempDir/optimML.dat")
+output16 <- read.table("data/output16.AllComp.thinned")
+input16 <- read.table("data/input16.dat",header=T)
+attach(input16)
+Dsamp <- as.matrix(read.table("figures/tempDir/Dsamp.dat"))
+pdf(file="figures/tempDir/V%dfitted.pdf",onefile=FALSE,width=10,height=5.5)
+plotVi(Dsamp,input16)
+dev.off()
+detach(input16)
+@
+\begin{figure}
+  \centering
+  \subfloat[v2]{\includegraphics[scale=0.30]{figures/tempDir/V1fitted}}
+  \subfloat[v3]{\includegraphics[scale=0.30]{figures/tempDir/V2fitted}}\\
+  \subfloat[v4]{\includegraphics[scale=0.30]{figures/tempDir/V3fitted}}
+  \subfloat[v5]{\includegraphics[scale=0.30]{figures/tempDir/V4fitted}}
+  \caption{Curves fit to the 16-point data with the all-components
+  algorithm. The green curves are drawn with the maximum likelihood estimates for the parameters found with the L-BFGS-B algorithm \cite{Byrd95} as implemented in the \textit{R optim()} function. }
+  \label{fits}
+\end{figure}

Added: trunk/PathwayModeling/thesispaper/figure8.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure8.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure8.Snw	2006-04-03 15:41:40 UTC (rev 954)
@@ -0,0 +1,25 @@
+<<fig8, echo=F,eval=F>>=7
+source("R/getMSDvsEvals.R")
+source("R/plotMSD16.R")
+source('R/paperSSQ.R')
+input16 <- read.table('data/input16.dat',header=T)
+attach(input16)
+OneComp.MSD.dat <- read.table("data/1comp.MSD.dat")
+AllComp.MSD.dat <- read.table("data/AllComp.MSD.dat")
+for (i in 1:10) {
+file <- sub('#',as.character(i),'NKC.MSD.dat#')
+assign(file, read.table(paste("data/",file,sep="")))
+}
+pdf(file="figures/tempDir/MSR16.pdf",width=9,height=6)
+plotMSD16()
+dev.off()
+detach(input16)
+@
+\begin{figure}
+  \centering
+    \includegraphics[scale=0.5]{figures/tempDir/MSR16}
+  \caption[Mean squared residuals vs. number of likelihood
+  evaluations]{Mean squared residuals vs. number of likelihood
+    evaluations for the 5-reaction model}
+  \label{SSQvsIter}
+\end{figure}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [953] trunk/PathwayModeling/thesispaper

[<r_b...@us...>]

Revision: 953
Author:   r_burrows
Date:     2006-04-03 08:39:23 -0700 (Mon, 03 Apr 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=953&view=rev

Log Message:
-----------
separate pages: initial commit

Added Paths:
-----------
    trunk/PathwayModeling/thesispaper/figure1.Snw
    trunk/PathwayModeling/thesispaper/figure2.Snw
Added: trunk/PathwayModeling/thesispaper/figure1.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure1.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure1.Snw	2006-04-03 15:39:23 UTC (rev 953)
@@ -0,0 +1,6 @@
+\begin{figure}
+  \centering
+  \includegraphics[scale=0.9]{figures/glycolysis}
+  \caption{Production of methylglyoxal in hyperglycemia}
+  \label{glycolysis}
+\end{figure}

Added: trunk/PathwayModeling/thesispaper/figure2.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/figure2.Snw	                        (rev 0)
+++ trunk/PathwayModeling/thesispaper/figure2.Snw	2006-04-03 15:39:23 UTC (rev 953)
@@ -0,0 +1,17 @@
+<<fig2,echo=F,eval=F>>=2
+source("R/pulse.R")
+rawdata <- read.table("data/rawdata.dat",header=T)
+attach(rawdata)
+pdf(file="figures/tempDir/pulse.pdf",width=9,height=5)
+pulse()
+dev.off()
+detach(rawdata)
+@
+    \begin{figure}
+      \centering
+      \includegraphics[scale=0.5]{figures/tempDir/pulse}
+      \caption[Reactant concentrations following a pulse of R1]{Reactant concentrations following a pulse of R1 at
+      $time=20$ for the sequence of reactions $R1\rightarrow
+      R2\rightarrow R3\rightarrow R4\rightarrow R5\rightarrow sink$.}
+      \label{pulse}
+    \end{figure}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[R-gregmisc-users] SF.net SVN: r-gregmisc: [952] trunk/PathwayModeling/thesispaper

[<r_b...@us...>]

Revision: 952
Author:   r_burrows
Date:     2006-04-03 08:34:00 -0700 (Mon, 03 Apr 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=952&view=rev

Log Message:
-----------
moved figures, tables to separate pages

Modified Paths:
--------------
    trunk/PathwayModeling/thesispaper/introduction.Snw
    trunk/PathwayModeling/thesispaper/methods.Snw
    trunk/PathwayModeling/thesispaper/paper.Snw
    trunk/PathwayModeling/thesispaper/results.Snw
Modified: trunk/PathwayModeling/thesispaper/introduction.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/introduction.Snw	2006-03-29 00:44:36 UTC (rev 951)
+++ trunk/PathwayModeling/thesispaper/introduction.Snw	2006-04-03 15:34:00 UTC (rev 952)
@@ -23,12 +23,6 @@
 that explain hyperglycemic toxicity in diabetes
 \cite{Oates02,Brownlee01}. One mechanism is illustrated in
 Figure~\ref{glycolysis}.
-\begin{figure}
-  \centering
-  \includegraphics[scale=0.9]{figures/glycolysis}
-  \caption{Production of methylglyoxal in hyperglycemia}
-  \label{glycolysis}
-\end{figure}
 Some of the damage to tissue components seen in diabetes is thought
 to be the result of reactions with glycolytic intermediates such as
 methylglyoxal. Nishikawa et al. \cite{Nishikawa00} have

Modified: trunk/PathwayModeling/thesispaper/methods.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/methods.Snw	2006-03-29 00:44:36 UTC (rev 951)
+++ trunk/PathwayModeling/thesispaper/methods.Snw	2006-04-03 15:34:00 UTC (rev 952)
@@ -16,10 +16,8 @@
 # trim the Gillespie output
 rawdata <- read.table('data/gillespie.out',header=T)[2528:7160,]
 # sampling times:
-# times12 <- c(16:19,20.5,21,seq(24,39,3))
 times16 <- c(16:19,20.5,21,seq(22,40,2))
-# times25 <- c(16:19,20.5,21:40)
-# generating the MCMC input files, e.g., input16.dat
+# generating the MCMC input file input16.dat
 data <- getPaperData(rawdata,20,times16,npoints=3, varVector=c(50,50,50,50,50))
 rates <- getPaperRates(data,1:12,13:48)
 temp <- matrix(0,nrow=16,ncol=11)
@@ -60,23 +58,6 @@
     For the 5-reaction sequence of reactions 
     the perturbation of $R1$ at $time = 20$ results in the time
     courses plotted in Figure~\ref{pulse}.
-<<echo=F,eval=F>>=2
-source("R/pulse.R")
-rawdata <- read.table("data/rawdata.dat",header=T)
-attach(rawdata)
-pdf(file="figures/tempDir/pulse.pdf",width=9,height=5)
-pulse()
-dev.off()
-detach(rawdata)
-@
-    \begin{figure}
-      \centering
-      \includegraphics[scale=0.5]{figures/tempDir/pulse}
-      \caption[Reactant concentrations following a pulse of R1]{Reactant concentrations following a pulse of R1 at
-      $time=20$ for the sequence of reactions $R1\rightarrow
-      R2\rightarrow R3\rightarrow R4\rightarrow R5\rightarrow sink$.}
-      \label{pulse}
-    \end{figure}
     For each time point there are 5 values for the reactant
     concentrations and 5 values for the estimated reaction rates.
     The data at each time point was generated by sampling 3 values for
@@ -141,32 +122,6 @@
       \deriv{R5}{t} &= v_5 = \frac{d_7R4}{d_8 + R4} - d_9R5
     \end{align*}
 
-\begin{table}
- \begin{center}
-    \caption{Rate constants used in the Gillespie simulator}
-    \begin{tabular}{c|r}
-      rate constant & value \\
-      \hline
-      $k_1$ & 1.600 \\
-      $k_2$ & 0.540 \\
-      $k_3$ & 19.500 \\
-      $k_4$ & 2.125 \\
-      $k_5$ & 0.190 \\
-      $k_6$ & 8.460 \\
-      $k_7$ & 2.077 \\
-      $k_8$ & 0.090 \\
-      $k_9$ & 4.560 \\
-      $k_{10}$ & 1.400 \\
-      $k_{11}$ & 0.106 \\
-      $k_{12}$ & 3.670 \\
-      $k_{13}$ & 1.640 \\
-      $k_{14}$ & 0.400 \\
-      \hline
-    \end{tabular}
-    \label{ki}
-  \end{center}
-\end{table}
-
   \subsection{Statistical Models}
 
     The statistical model of the parameters is 
@@ -237,24 +192,6 @@
     The all-components algorithm (Figure~\ref{allComp}) changes all the components
     simultaneously by sampling from a multivariate normal distribution
     centered at the current point.
-    \begin{figure}
-      \centering
-      \subfloat[1-component]{\includegraphics[scale=0.50]{figures/1comp}
-      \label{1comp}}
-      \qquad
-      \subfloat[all-components]{\includegraphics[scale=0.50]{figures/allcomp}
-      \label{allComp}}
-      \qquad
-      \subfloat[NKC]{\includegraphics[scale=0.50]{figures/nkc}\label{nkc}}
-      \caption[Movement of Markov chains with the
-       Metropolis algorithms]{Movement of Markov chains with the component-wise and
-      all-components Metropolis algorithms. Movement in a
-      2-dimensional space is illustrated, so each point has 2
-      components. The dotted lines are contours of equal probability
-      density for the proposal distributions and the dashed lines are
-      probabilty contours of the target distribution.}
-      \label{1comp_vs_all}
-    \end{figure}
     The component-wise Metropolis algorithm has the advantage of
     simplicity but may move very slowly if the components are highly
     correlated. The all-components Metropolis avoids the problems with

Modified: trunk/PathwayModeling/thesispaper/paper.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/paper.Snw	2006-03-29 00:44:36 UTC (rev 951)
+++ trunk/PathwayModeling/thesispaper/paper.Snw	2006-04-03 15:34:00 UTC (rev 952)
@@ -1,5 +1,5 @@
-\documentclass{elsart}
-% \documentclass[doublespacing]{elsart}
+% \documentclass{elsart}
+\documentclass[doublespacing]{elsart}
 \usepackage{graphicx}
 \usepackage[nogin]{Sweave}
 \usepackage[numbers]{natbib} \bibliographystyle{plainnat}
@@ -26,7 +26,8 @@
 \begin{frontmatter}
 
 \title{Statistical Modeling of Biochemical Pathways}
-\author{Robert B. Burrows}
+% \author{Robert B. Burrows}\footnote{corresponding author:\\Robert Burrows\\1506 Chopmist Hill Road\\North Scituate, RI 02857\\401-647-5290\\rb...@ne...}
+\author{Robert B. Burrows}\footnote{corresponding author:\\Robert Burrows\\[-4mm]1506 Chopmist Hill Road\\[-4mm]North Scituate, RI 02857\\[-4mm]401-647-5290\\[-4mm]rb...@ne...}
 \address{New England Biometrics, North Scituate, RI}
 \author{Gregory R. Warnes}
 \address{Pfizer, Inc., Groton, CT}
@@ -62,4 +63,42 @@
 
 \bibliography{./refs}
 
+\SweaveInput{table1}
+
+\clearpage
+
+\SweaveInput{table2}
+
+\clearpage
+
+\SweaveInput{figure1}
+
+\clearpage
+
+\SweaveInput{figure2}
+
+\clearpage
+
+\SweaveInput{figure3}
+
+\clearpage
+
+\SweaveInput{figure4}
+
+\clearpage
+
+\SweaveInput{figure5}
+
+\clearpage
+
+\SweaveInput{figure6}
+
+\clearpage
+
+\SweaveInput{figure7}
+
+\clearpage
+
+\SweaveInput{figure8}
+
 \end{document}

Modified: trunk/PathwayModeling/thesispaper/results.Snw
===================================================================
--- trunk/PathwayModeling/thesispaper/results.Snw	2006-03-29 00:44:36 UTC (rev 951)
+++ trunk/PathwayModeling/thesispaper/results.Snw	2006-04-03 15:34:00 UTC (rev 952)
@@ -9,70 +9,8 @@
 (Figure~\ref{densities}), were skewed to the right and had thicker
 tails than normal distributions.
 
-<<fig4,echo=F,eval=F>>=3
-source("R/paperSSQ.R")
-source("R/getModes.R")
-source("R/do.optim.R")
-source("R/plotDensities.R")
-output16 <- read.table("data/output16.AllComp.thinned")
-input16 <- read.table("data/input16.dat", header=T)
-attach(input16)
-temp<-output16[sample(1:20000,5000),]
-temp2<-numeric(5000)
-for (i in 1:5000) temp2[i]<-paperSSQ(temp[i,])
-temp<-temp[order(temp2),]
-write.table(temp[1:4750,],file="figures/tempDir/Dsamp.dat",row.names=F,col.names=F)
-mcmcML <- as.numeric(temp[1,-10])
-write.table(mcmcML,file="figures/tempDir/mcmcML.dat",row.names=F,col.names=F)
-modes<-getModes(output16)
-temp<-do.optim(start=modes[-10],scail=modes[-10])
-temp<-do.optim(start=temp$par,scail=temp$par)
-optimML<-temp$par
-write.table(optimML,file="figures/tempDir/optimML.dat",row.names=F,col.names=F)
-SD <- numeric(9)
-for (i in 1:9) SD[i] <- sd(output16[,i])
-pdf(file="figures/tempDir/densities.pdf",width=6,height=6)
-par(mfrow=c(3,3))
-plotDensities(output16)
-dev.off()
-par(mfrow=c(1,1))
-detach(input16)
-@
-\begin{figure}
-  \centering
-  \includegraphics[scale=0.8]{figures/tempDir/densities}
-  \caption[Histograms of the marginal probability distributions]{Histograms of the marginal probability distributions for
-  the 5-reaction model generated with the all-components Metropolis
-  algorithm and the 16-point dataset. The curves are normal densities with means equal to the
-  medians of the distributions and variances equal to the variances of
-  the distributions. \textit{Red vertical lines indicate the parameters values that 
-  minimize the mean squared residuals.}}
-  \label{densities}
-\end{figure}
 The effect of the number of data points on the parameter distributions
 can be seen in Figure~\ref{converged}.
-<<fig5,echo=F,eval=F>>=4
-source("R/plotDensity.R")
-source("R/plotConverged.R")
-output12 <- read.table("data/output12.AllComp.thinned")
-output16 <- read.table("data/output16.AllComp.thinned")
-output25 <- read.table("data/output25.AllComp.thinned")
-pdf(file="figures/tempDir/converged.pdf",width=6,height=6)
-par(mfrow=c(3,3))
-plotConverged()
-dev.off()
-par(mfrow=c(1,1))
-@
-\begin{figure}
-  \centering
-  \includegraphics[scale=0.9]{figures/tempDir/converged}
-  \caption{\textit{Posterior distributions from different numbers} of data
-  points for the all-components algorithm. (---------) prior
-  distribution; ({\color{red} - - - -}) 12 points; ({\color{green}
-  $\cdots\cdots$}) 16 points; ({\color{blue} -- $\cdot$ -- $\cdot$ --}) 25
-  points}
-  \label{converged}
-\end{figure}
 We see some improved precision as the number of points
 increases from 16 to 25 but it is not pronounced. Overall, the 
 reduction in width varied from 18-fold for $d_9$ and 9-fold for $d_1$ to 
@@ -81,32 +19,6 @@
 distributions. There is correlation between some pairs of parameters, e.g.,
 $d_1$ -- $d_2$, but no evidence of multi-modality.
 
-<<fig6, echo=F,eval=F>>=5
-source("R/paperPairs.R")
-mcmcML <-scan("figures/tempDir/mcmcML.dat")
-output16 <- read.table("data/output16.AllComp.thinned")
-mcmc.cor <- function(x,y) {
-    par(usr=c(0,1,0,1))
-    r <- cor(x,y)
-    txt <- format(r,digits=2)
-    text(0.5,0.5,txt,cex=1.4)
-    }
-pdf(file="figures/tempDir/scatterPlot.pdf",width=8,height=8)
-par(pch='.')
-paperPairs(output16[sample(1:20000,2000),-10],labels=c('d1','d2','d3','d4','d5','d6','d7','d8','d9'),lower.panel=mcmc.cor)
-dev.off()
-par(pch=1)
-@
-\begin{figure}
-  \centering
-  \includegraphics[scale=0.6]{figures/tempDir/scatterPlot}
-  \caption[Bivariate scatter plots of the parameter distributions]{Bivariate scatter plots of the parameter distributions for
-  the 5-reaction model found with the all-components Metropolis
-  algorithm (upper triangle); correlation coefficients (lower
-  triangle). The red lines indicate the maximum likelihood estimates of the parameters.}
-  \label{scatter}
-\end{figure}
-
 The value of the probability density for inference was assessed
 graphically. The probability density was used to find the maximum
 likelihood estimate for the model parameters and the 95\% confidence
@@ -114,53 +26,6 @@
 is shown in Figure~\ref{fits}. Quantitative measures of the fits for
 all the algorithms are given in Table~\ref{MSq}.
 
-<<fig7, echo=F, eval=F>>=6
-source("R/paperSSQ.R")
-source("R/getModes.R")
-source("R/do.optim.R")
-source("R/fitPaper.R")
-source("R/get95CI.R")
-source("R/plotVi.R")
-mcmcML <-scan("figures/tempDir/mcmcML.dat")
-optimML <-scan("figures/tempDir/optimML.dat")
-output16 <- read.table("data/output16.AllComp.thinned")
-input16 <- read.table("data/input16.dat",header=T)
-attach(input16)
-Dsamp <- as.matrix(read.table("figures/tempDir/Dsamp.dat"))
-pdf(file="figures/tempDir/V%dfitted.pdf",onefile=FALSE,width=10,height=5.5)
-plotVi(Dsamp,input16)
-dev.off()
-detach(input16)
-@
-\begin{figure}
-  \centering
-  \subfloat[v2]{\includegraphics[scale=0.33]{figures/tempDir/V1fitted}}
-  \subfloat[v3]{\includegraphics[scale=0.33]{figures/tempDir/V2fitted}}\\
-  \subfloat[v4]{\includegraphics[scale=0.33]{figures/tempDir/V3fitted}}
-  \subfloat[v5]{\includegraphics[scale=0.33]{figures/tempDir/V4fitted}}
-  \caption{Curves fit to the 16-point data with the all-components
-  algorithm. The green curves are drawn with the maximum likelihood estimates for the parameters found with the L-BFGS-B algorithm \cite{Byrd95} as implemented in the \textit{R optim()} function. }
-  \label{fits}
-\end{figure}
-
-\begin{table}[h]
-  \begin{center}
-    \caption{Mean squared residuals}
-    \begin{tabular}{c||c|c|c||c|c|c}
-       &
-       \multicolumn{3}{c||}{mean residual SSQ $\times 10^{-4}$} & \multicolumn{3}{c}{$R_{adj}^2$}\\
-      \cline{2-7}
-      algorithm & 12 pt. & 16 pt. & 25 pt. &
-      12 pt. & 16 pt. & 25 pt.\\
-      \hline
-       1-comp & 1.34 & 0.83 & 1.06 & 0.87 & 0.92 & 0.86\\
-       all-comp & 0.74 & 0.93 & 0.74 & 0.93 & 0.90 & 0.90 \\
-       NKC & 0.86 & 0.73 & 0.71 & 0.92 & 0.92 & 0.91
-    \end{tabular}
-    \label{MSq}
-  \end{center}
-\end{table}
-
 Rates of convergence are illustrated in Figure~\ref{SSQvsIter}. The
 mean sums of squared residuals (SSQ) are plotted vs. the number of
 likelihood evaluations for the three algorithms. The relatively 
@@ -173,31 +38,6 @@
 This is not a problem with the all-component Metropolis and NKC 
 algorithms since they update all the parameters at each iteration.
 
-<<fig8, echo=F,eval=F>>=7
-source("R/getMSDvsEvals.R")
-source("R/plotMSD16.R")
-source('R/paperSSQ.R')
-input16 <- read.table('data/input16.dat',header=T)
-attach(input16)
-OneComp.MSD.dat <- read.table("data/1comp.MSD.dat")
-AllComp.MSD.dat <- read.table("data/AllComp.MSD.dat")
-for (i in 1:10) {
-file <- sub('#',as.character(i),'NKC.MSD.dat#')
-assign(file, read.table(paste("data/",file,sep="")))
-}
-pdf(file="figures/tempDir/MSR16.pdf",width=9,height=6)
-plotMSD16()
-dev.off()
-detach(input16)
-@
-\begin{figure}
-  \centering
-    \includegraphics[scale=0.5]{figures/tempDir/MSR16}
-  \caption[Mean squared residuals vs. number of likelihood
-  evaluations]{Mean squared residuals vs. number of likelihood
-    evaluations for the 5-reaction model}
-  \label{SSQvsIter}
-\end{figure}
 The actual convergence times on a 3.2GHz P4 machine with 1GB of memory
 are 1--2 hours for the 1-component algorithm and about 1 minute for
 the all-components and Normal Kernel Coupler algorithms.


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.