v1.26

Patching map to handle multiple linear models and do search and replace
with a more elegant grep style that hopefully doesn't replace embedded
strings in other symbols

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rethinking
 Type: Package
 Title: Statistical Rethinking book package
-Version: 1.25
+Version: 1.26
 Date: 2013-12-13
 Author: Richard McElreath
 Maintainer: Richard McElreath <[email protected]>

R/map.r

@@ -66,7 +66,7 @@ map <- function( flist , start , data , method="BFGS" , hessian=TRUE , debug=FAL
         RHS <- f[[3]]
         LHS <- f[[2]]
         fname <- as.character( RHS[[1]] )
-        if ( fname=="+" | fname=="*" | fname=="-" | fname=="/" ) {
+        if ( fname=="+" | fname=="*" | fname=="-" | fname=="/" | fname=="%*%" ) {
             # linear model formula with no density function
             thetext <- as.character(RHS)
             thetext <- list( as.character(LHS) , paste( RHS[2] , RHS[1] , RHS[3] , collapse=" " ) )
@@ -94,6 +94,32 @@ map <- function( flist , start , data , method="BFGS" , hessian=TRUE , debug=FAL
         return( thetext )
     }
 
+    ##############
+    # grep function for search-replace of linear model symbols
+    # trick is that symbol needs to be preceded by [(=*+ ] so grep doesn't replace copies embedded inside other symbols
+    # e.g. don't want to expand the "p" inside "ample"
+    #
+    # target : string to search for (usually parameter name like "mu")
+    # replacement : what to replace with (usually a linear model)
+    # x : where to search, usually a formula as character
+    # add.par : whether to enclose replacement in parentheses
+
+    mygrep <- function( target , replacement , x , add.par=TRUE ) {
+        wild <- "[()=*+ ]"
+        pattern <- paste( wild , target , wild , sep="" , collapse="" )
+        m <- regexpr( pattern , x )
+        if ( m==-1 ) return( x )
+        s <- regmatches( x=x , m=m )
+
+        if ( add.par==TRUE ) replacement <- paste( "(" , replacement , ")" , collapse="" )
+
+        w.start <- substr(s,1,1)
+        w.end <- substr(s,nchar(s),nchar(s))
+
+        r <- paste( w.start , replacement , w.end , sep="" , collapse="" )
+        gsub( pattern=s , replacement=r , x=x , fixed=TRUE )
+    }
+
     ########################################
     # convert formulas to text in proper call order
 
@@ -140,12 +166,25 @@ map <- function( flist , start , data , method="BFGS" , hessian=TRUE , debug=FAL
 
     # check for linear models in flist2 and do search-replace in likelihood
     if ( length(flist2) > 1 ) {
-        for ( i in 2:length(flist2) ) {
+        for ( i in length(flist2):2 ) {
+            # linear models are class list
             if ( class(flist2[[i]])=="list" ) {
                 LHS <- flist2[[i]][[1]]
                 RHS <- flist2[[i]][[2]]
                 # replace in likelihood
-                flist2[[1]] <- gsub( LHS , RHS , flist2[[1]] )
+                #flist2[[1]] <- gsub( LHS , RHS , flist2[[1]] )
+                flist2[[1]] <- mygrep( LHS , RHS , flist2[[1]] , add.par=FALSE )
+
+                # also search in other linear models above this one
+                if ( i > 2 ) {
+                    # RHSp <- paste( "(" , RHS , ")" , collapse="" )
+                    for ( j in (i-1):2 ) {
+                        if ( class(flist2[[j]])=="list" ) {
+                            #flist2[[j]][[2]] <- gsub( LHS , RHSp , flist2[[j]][[2]] )
+                            flist2[[j]][[2]] <- mygrep( LHS , RHS , flist2[[j]][[2]] , add.par=TRUE )
+                        }
+                    }
+                }
                 # remove symbol from list of parameters with priors
                 pars_with_priors[[ LHS ]] <- NULL
             }

man/Trolley.Rd

@@ -0,0 +1,39 @@
+\name{Trolley}
+\alias{Trolley}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Experimental data on ethical dilemmas}
+\description{
+  These data comprise outcomes of experimental ethical dilemmas that are often called 'trolley' problems. Data kindly provided by Fiery Cushman.
+}
+\usage{
+data(Trolley)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+}
+\format{
+    \enumerate{
+        \item case: a code that combines treatment and story labels
+        \item response: participant's rating of appropriateness of action in story
+        \item order: integer order story appeared, within participant
+        \item id: participant id (factor)
+        \item age: participant's age in years
+        \item male: participant's gender; 1 for male, 0 for female
+        \item edu: participant's highest educational level
+        \item action: treatment code for story with action (1) or inaction (0)
+        \item intention: treatment code for intent (1) or lack of intent (0)
+        \item contact: treatmetn code for contact action (1) or lack of contact (0)
+        \item story: factor label for basic scenario modified by treatments
+        \item action2: alternative coding of action that is union of action and contact variables
+    }
+}
+\value{
+}
+\references{Cushman et al. 2006. Psychological Science 17:1082--1089.}
+\seealso{}
+\examples{
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ }
+

man/Wines2012.Rd

@@ -23,7 +23,7 @@ data(Wines2012)
 }
 \value{
 }
-\references{}
+\references{Raw data from http://www.liquidasset.com/report161.html}
 \seealso{}
 \examples{
 }