v2.10 candidate

-few more R4 class() fixes
-ulam support for cmdstanr and reduce_sum via threads argument. See README
-tests added for cmdstanr support

DESCRIPTION

@@ -1,12 +1,12 @@
 Package: rethinking
 Type: Package
 Title: Statistical Rethinking book package
-Version: 2.01
-Date: 2020-04-28
+Version: 2.10
+Date: 2020-05-13
 Author: Richard McElreath
 Maintainer: Richard McElreath <richard_mcelreath@eva.mpg.de>
 Imports: coda, MASS, mvtnorm, loo, shape
-Depends: R (>= 3.5.0), rstan (>= 2.10.0), parallel, methods, stats, graphics, dagitty
-Suggests: testthat
+Depends: R (>= 3.5.0), rstan (>= 2.10.0), parallel, methods, stats, graphics
+Suggests: testthat, dagitty, cmdstanr
 Description: Utilities for fitting and comparing models
 License: GPL (>= 3)

R/plotting.r

@@ -318,25 +318,25 @@ shade <- function( object , lim , label=NULL , col=col.alpha("black",0.15) , bor
     if ( missing(object) ) stop( "No density or formula object." )
     from <- lim[1]
     to <- lim[2]
-    if ( class(object)=="formula" ) {
+    if ( class(object)[1]=="formula" ) {
         # formula input
         x1 <- eval( object[[3]] )
         y1 <- eval( object[[2]] )
         x <- x1[ x1>=from & x1<=to ]
         y <- y1[ x1>=from & x1<=to ]
     }
-    if ( class(object)=="density" ) {
+    if ( class(object)[1]=="density" ) {
         # density input
         x <- object$x[ object$x>=from & object$x<=to ]
         y <- object$y[ object$x>=from & object$x<=to ]
     }
-    if ( class(object)=="matrix" & length(dim(object))==2 ) {
+    if ( class(object)[1]=="matrix" & length(dim(object))==2 ) {
         # matrix defining confidence region around a curve
         y <- c( object[1,] , object[2,][ncol(object):1] ) # reverse second row
         x <- c( lim , lim[length(lim):1] ) # lim needs to be x-axis values
     }
     # draw
-    if ( class(object)=="matrix" ) {
+    if ( class(object)[1]=="matrix" ) {
         polygon( x , y , col=col , border=border , ... )
     } else {
         polygon( c( x , to , from ) , c( y , 0 , 0 ) , col=col , border=border , ... )

R/trankplot.R

@@ -5,15 +5,15 @@
 
 # convert matrix to a matrix of ranks (over entire matrix)
 rank_mat <- function( x ) {
-    if ( class(x)=="numeric" ) x <- array( x , dim=c(length(x),1) )
+    if ( class(x)[1]=="numeric" ) x <- array( x , dim=c(length(x),1) )
     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 , add=FALSE , stacked=FALSE , ... ) {
 
-    if ( !(class(object) %in% c("map2stan","ulam","stanfit")) ) stop( "requires map2stan, ulam or stanfit object" )
+    if ( !(class(object)[1] %in% c("map2stan","ulam","stanfit")) ) stop( "requires map2stan, ulam or stanfit object" )
 
-    if ( class(object) %in% c("map2stan","ulam") ) object <- object@stanfit
+    if ( class(object)[1] %in% c("map2stan","ulam") ) object <- object@stanfit
 
     # get all chains, not mixed, from stanfit
     # exclude warmup, because we'll rank only proper draws

R/ulam-class.R

@@ -237,22 +237,40 @@ traceplot_ulam <- function( object , pars , chains , col=rethink_palette , alpha
     }
     n_iter <- object@sim$iter
     n_warm <- object@sim$warmup
+    n_samples_extracted <- dim( post )[1]
     wstart <- 1
     wend <- n_iter
-    if ( missing(window) ) window <- c(trim,n_iter)
+
     if ( !missing(window) ) {
         wstart <- window[1]
         wend <- window[2]
     }
+
+    show_warmup <- TRUE
+    if ( missing(window) ) {
+        if ( n_iter > n_samples_extracted ) {
+            # probably no warmup saved
+            wend <- n_samples_extracted
+            show_warmup <- FALSE
+            trim <- 1 # no trim when warmup not shown
+            n_iter <- n_samples_extracted
+        }
+        window <- c(trim,n_iter)
+    }
 
+    print(n_samples_extracted)
+    print(wstart)
+    print(wend)
+
     # worker
     plot_make <- function( main , par , neff , ... ) {
         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])
         ylim <- ylim + c( -diff/2 , diff/2 )
-        polygon( n_warm*c(-1,1,1,-1) , ylim[c(1,1,2,2)] , col=bg , border=NA )
+        if ( show_warmup==TRUE )
+            polygon( n_warm*c(-1,1,1,-1) , ylim[c(1,1,2,2)] , col=bg , border=NA )
         neff_use <- neff[ names(neff)==main ]
         mtext( paste("n_eff =",round(neff_use,0)) , 3 , adj=1 , cex=0.9 )
         mtext( main , 3 , adj=0 , cex=1 )