minor patch

- doc for reedfrogs data (thanks to Ben Bolker)
- tweaks to trankplot code, various plotting functions

DESCRIPTION

@@ -2,7 +2,7 @@ Package: rethinking
 Type: Package
 Title: Statistical Rethinking book package
 Version: 1.88
-Date: 2019-03-02
+Date: 2019-07-09
 Author: Richard McElreath
 Maintainer: Richard McElreath <[email protected]>
 Imports: coda, MASS, mvtnorm, loo

R/dashboard.r

@@ -98,8 +98,12 @@ dashboard <- function( fit , warmup=FALSE , plot=TRUE , trank=TRUE ) {
         if ( sum(x[,5])>10 ) text( 0.5 , 0.2 , "Check yourself before\nyou wreck yourself" , cex=1.5 )
 
         # three trace plots with lowest n_eff
-        plot_make( "log-probability" , "lp__" , y$summary["lp__","n_eff"] )
-        for ( nc in 1:n_chains ) plot_chain( post[, nc , "lp__" ] , nc )
+        if ( trank==TRUE ) {
+            trankplot( fit , pars="lp__" , lp=TRUE , add=TRUE )
+        } else {
+            plot_make( "log-probability" , "lp__" , y$summary["lp__","n_eff"] )
+            for ( nc in 1:n_chains ) plot_chain( post[, nc , "lp__" ] , nc )
+        }
     }
     # invisible result
     invisible(x)

R/trankplot.R

@@ -9,7 +9,7 @@ rank_mat <- function( x ) {
     matrix( rank(x) , ncol=ncol(x) )
 }
 
-trankplot <- function( object , bins=30 , pars , chains , col=rethink_palette , alpha=1 , bg=col.alpha("black",0.15) , ask=TRUE , window , n_cols=3 , max_rows=5 , lwd=1.5 , lp=FALSE  , axes=FALSE , off=0 , ... ) {
+trankplot <- function( object , bins=30 , pars , chains , col=rethink_palette , alpha=1 , bg=col.alpha("black",0.15) , ask=TRUE , window , n_cols=3 , max_rows=5 , lwd=1.5 , lp=FALSE  , axes=FALSE , off=0 , add=FALSE , ... ) {
 
     if ( !(class(object) %in% c("map2stan","ulam","stanfit")) ) stop( "requires map2stan, ulam or stanfit object" )
 
@@ -47,9 +47,9 @@ trankplot <- function( object , bins=30 , pars , chains , col=rethink_palette ,
     ranks <- post
     n_samples <- dim(post)[1]
     for ( i in 1:n_pars ) {
-        ranks[,,i] <- rank_mat( post[,,i] )
+        ranks[,,i] <- rank_mat( post[,, pars[i] ] )
     }
-    breaks <- hist( ranks[,1,1] , breaks=bins , plot=FALSE )$breaks
+    breaks <- hist( ranks[,,1] , breaks=bins , plot=FALSE )$breaks
     h <- array( NA , dim=c( length(breaks)-1 , n_chains , n_pars ) )
     for ( i in 1:n_pars ) {
         for ( j in 1:n_chains ) {
@@ -87,6 +87,7 @@ trankplot <- function( object , bins=30 , pars , chains , col=rethink_palette ,
             plot( NULL , xlab="" , ylab="" , bty="l" , xlim=range(breaks) , ylim=ylim , xaxt="n" , yaxt="n" , ... )
         neff_use <- neff[ names(neff)==main ]
         mtext( paste("n_eff =",round(neff_use,0)) , 3 , adj=1 , cex=0.9 )
+        if ( main=="lp__" ) main <- "log-probability"
         mtext( main , 3 , adj=0 , cex=1 )
     }
     # make the trank
@@ -105,10 +106,10 @@ trankplot <- function( object , bins=30 , pars , chains , col=rethink_palette ,
 
     # make window
     #set_nice_margins()
-    par(mgp = c(0.5, 0.5, 0), mar = c(1.5, 1.5, 1.5, 1) + 0.1, 
-            tck = -0.02)
-    par(mfrow=c(n_rows_per_page,n_cols))
-
+    if ( add==FALSE ) {
+        par(mgp = c(0.5, 0.5, 0), mar = c(1.5, 1.5, 1.5, 1) + 0.1, tck = -0.02)
+        par(mfrow=c(n_rows_per_page,n_cols))
+    } 
     # draw traces
     n_ppp <- n_rows_per_page * n_cols # num pars per page
     for ( k in 1:n_pages ) {
@@ -117,7 +118,7 @@ trankplot <- function( object , bins=30 , pars , chains , col=rethink_palette ,
             pi <- i + (k-1)*n_ppp
             if ( pi <= n_pars ) {
                 if ( pi == 2 ) {
-                    if ( ask==TRUE ) {
+                    if ( ask==TRUE & add==FALSE ) {
                         ask_old <- devAskNewPage(ask = TRUE)
                         on.exit(devAskNewPage(ask = ask_old), add = TRUE)
                     }

R/ulam-class.R

@@ -204,24 +204,25 @@ traceplot_ulam <- function( object , pars , chains , col=rethink_palette , alpha
     if ( class(object) %in% c("map2stan","ulam") ) object <- object@stanfit
 
     # get all chains, not mixed, from stanfit
-    if ( missing(pars) )
+    if ( missing(pars) ) {
         post <- extract(object,permuted=FALSE,inc_warmup=TRUE)
-    else
+        dimnames <- attr(post,"dimnames")
+        pars <- dimnames$parameters
+        # cut out "dev" and "lp__" and "log_lik"
+        wdev <- which(pars=="dev")
+        if ( length(wdev)>0 ) pars <- pars[-wdev]
+        wlp <- which(pars=="lp__")
+        if ( length(wlp)>0 & lp==FALSE ) pars <- pars[-wlp]
+        wlp <- grep( "log_lik" , pars , fixed=TRUE )
+        if ( length(wlp)>0 ) pars <- pars[-wlp]
+    } else
         post <- extract(object,pars=pars,permuted=FALSE,inc_warmup=TRUE)
 
     # names
     dimnames <- attr(post,"dimnames")
     n_chains <- length(dimnames$chains)
     if ( missing(chains) ) chains <- 1:n_chains
-    pars <- dimnames$parameters
     chain.cols <- rep_len(col,n_chains)
-    # cut out "dev" and "lp__" and "log_lik"
-    wdev <- which(pars=="dev")
-    if ( length(wdev)>0 ) pars <- pars[-wdev]
-    wlp <- which(pars=="lp__")
-    if ( length(wlp)>0 & lp==FALSE ) pars <- pars[-wlp]
-    wlp <- grep( "log_lik" , pars , fixed=TRUE )
-    if ( length(wlp)>0 ) pars <- pars[-wlp]
 
     # figure out grid and paging
     n_pars <- length( pars )
@@ -246,7 +247,7 @@ traceplot_ulam <- function( object , pars , chains , col=rethink_palette , alpha
 
     # worker
     plot_make <- function( main , par , neff , ... ) {
-        ylim <- c( min(post[wstart:wend,,par]) , max(post[wstart:wend,,par]) )
+        ylim <- c( min(post[wstart:wend,,pars[par]]) , max(post[wstart:wend,,pars[par]]) )
         plot( NULL , xlab="" , ylab="" , type="l" , xlim=c(wstart,wend) , ylim=ylim , ... )
         # add polygon here for warmup region?
         diff <- abs(ylim[1]-ylim[2])
@@ -285,7 +286,7 @@ traceplot_ulam <- function( object , pars , chains , col=rethink_palette , alpha
                 plot_make( pars[pi] , pi , n_eff , ... )
                 for ( j in 1:n_chains ) {
                     if ( j %in% chains )
-                        plot_chain( post[ , j , pi ] , j , ... )
+                        plot_chain( post[ , j , pars[pi] ] , j , ... )
                 }#j
             }
         }#i
@@ -295,7 +296,7 @@ traceplot_ulam <- function( object , pars , chains , col=rethink_palette , alpha
 }
 setMethod("traceplot", "ulam" , function(object,...) traceplot_ulam(object,...) )
 
-setMethod( "plot" , "ulam" , function(x,y,...) precis_plot(precis(x,depth=y),...) )
+setMethod( "plot" , "ulam" , function(x,depth=1,...) precis_plot(precis(x,depth=depth),...) )
 
 setMethod("nobs", "ulam", function (object, ...) { 
     z <- attr(object,"nobs") 

man/reedfrogs.Rd

@@ -0,0 +1,32 @@
+\name{reedfrogs}
+\alias{reedfrogs}
+\docType{data}
+\title{Data on reed frog predation experiments}
+\description{
+  Data on lab experiments on the density- and size-dependent
+  predation rate of an African reed frog, \emph{Hyperolius
+    spinigularis},
+  from Vonesh and Bolker 2005 
+}
+\usage{data(reedfrogs)}
+\format{
+  Various data with variables:
+  \describe{
+    \item{\code{density}}{initial tadpole density (number of tadpoles
+      in a 1.2 x 0.8 x 0.4 m tank) [experiment 1]}
+    \item{\code{pred}}{factor: predators present or absent [experiment 1]}
+    \item{\code{size}}{factor: big or small tadpoles [experiment 1]}
+    \item{\code{surv}}{number surviving}
+    \item{\code{propsurv}}{proportion surviving (=surv/density) [experiment 1]}
+  }
+}
+\source{
+  Vonesh and Bolker (2005) Compensatory larval responses shift
+  trade-offs associated with predator-induced hatching plasticity.
+  Ecology 86:1580-1591
+}
+\examples{
+data(reedfrogs)
+boxplot(propsurv~size*density*pred,data=reedfrogs)
+}
+\keyword{datasets}