Compatibility release for R 4.0.0

Version 2.01 fixes problems introduced when R 4.0.0 was released. There should not be any functionality changes.

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: rethinking
 Type: Package
 Title: Statistical Rethinking book package
-Version: 2.00
-Date: 2020-03-06
+Version: 2.01
+Date: 2020-04-28
 Author: Richard McElreath
 Maintainer: Richard McElreath <[email protected]>
 Imports: coda, MASS, mvtnorm, loo, shape

R/map-quap.r

@@ -503,7 +503,7 @@ quap <- function( flist , data , start , method="BFGS" , hessian=TRUE , debug=FA
 
     if ( hessian & dofit ) {
         vcov <- try( solve(fit$hessian) )
-        if ( class(vcov)=="try-error" ) {
+        if ( class(vcov)[1]=="try-error" ) {
             warning( "Error when computing variance-covariance matrix (Hessian). Fit may not be reliable." )
             vcov <- matrix( NA , nrow=length(pars) , ncol=length(pars) )
         }

R/postcheck.r

@@ -10,7 +10,7 @@ postcheck <- function( fit , x , prob=0.89 , window=20 , n=1000 , col=rangi2 , .
     pred <- link(fit,n=n)
     sims <- sim(fit,n=n)
 
-    if ( class(pred)=="list" )
+    if ( class(pred)[1]=="list" )
         if ( length(pred)>1 ) pred <- pred[[1]]
 
     # get outcome variable

R/ulam-function.R

@@ -43,10 +43,10 @@ ulam <- function( flist , data , pars , pars_omit , start , chains=1 , cores=1 ,
         # pre-scan for character variables and remove
         x_to_remove <- c()
         for ( i in 1:length(data) ) {
-            if ( class(data[[i]]) =="character" ) {
+            if ( class(data[[i]])[1] =="character" ) {
                 x_to_remove <- c( x_to_remove , names(data)[i] )
             }
-            if ( class(data[[i]]) =="factor" ) {
+            if ( class(data[[i]])[1] =="factor" ) {
                 if ( coerce_int==FALSE )
                     x_to_remove <- c( x_to_remove , names(data)[i] )
                 else {
@@ -65,10 +65,10 @@ ulam <- function( flist , data , pars , pars_omit , start , chains=1 , cores=1 ,
         }
         # pre-scan for index variables (integer) that are numeric by accident
         for ( i in 1:length(data) ) {
-            if ( class(data[[i]])!="character" ) {
+            if ( class(data[[i]])[1]!="character" ) {
                 if ( all( as.integer(data[[i]])==data[[i]] , na.rm=TRUE ) ) {
                     #data[[i]] <- as.integer(data[[i]])
-                    if ( class(data[[i]])!="integer" & !inherits(data[[i]],"matrix") ) {
+                    if ( class(data[[i]])[1]!="integer" & !inherits(data[[i]],"matrix") ) {
                         if ( coerce_int==TRUE ) {
                             data[[i]] <- as.integer(data[[i]])
                         }
@@ -567,7 +567,7 @@ ulam <- function( flist , data , pars , pars_omit , start , chains=1 , cores=1 ,
 
         # try to determine Stan type from class
         stan_type <- "real"
-        if ( class( data[[var_name]] )=="integer" ) stan_type <- "int"
+        if ( class( data[[var_name]] )[1]=="integer" ) stan_type <- "int"
         if ( inherits( data[[var_name]] , "matrix" ) ) {
             stan_type <- "matrix"
             the_dims <- list( stan_type , the_dims[1] , the_dims[2] )
@@ -580,8 +580,8 @@ ulam <- function( flist , data , pars , pars_omit , start , chains=1 , cores=1 ,
             if ( the_dims[[2]] > 1 ) the_dims[[1]] <- "vector"
         }
         # check for integer array
-        if ( class( data[[var_name]] )=="array" ) {
-            if ( class( data[[var_name]][1] )=="integer" ) {
+        if ( class( data[[var_name]] )[1]=="array" ) {
+            if ( class( data[[var_name]][1] )[1]=="integer" ) {
                 the_dims <- list( "int_array" , dim( data[[var_name]] ) )
             } else {
                 the_dims <- list( "real" , dim( data[[var_name]] ) )
@@ -819,7 +819,9 @@ ulam <- function( flist , data , pars , pars_omit , start , chains=1 , cores=1 ,
     for ( i in 1:nrow(symbol_graph) ) {
         left_symbol <- rownames(symbol_graph)[i]
         # scan symbols on right-hand side
-        right_symbols <- get_all_symbols( flist[[ symbol_lines[i] ]][[3]] )
+        right_symbols <- NULL
+        if ( i <= length(symbol_lines) )
+            right_symbols <- get_all_symbols( flist[[ symbol_lines[[i]] ]][[3]] )
         if ( length(right_symbols)>0 ) {
             for ( j in 1:length(right_symbols) ) {
                 if ( right_symbols[j] %in% colnames(new_graph) ) {
@@ -885,7 +887,7 @@ ulam <- function( flist , data , pars , pars_omit , start , chains=1 , cores=1 ,
                     # data so check type
                     need_type <- template$dims[k+1]
                     if ( need_type %in% c("real","vector") ) {
-                        if ( class(data[[ right[k] ]]) != "numeric" )
+                        if ( class(data[[ right[k] ]])[1] != "numeric" )
                             data[[ right[k] ]] <- as.numeric(data[[ right[k] ]])
                     }
                 }

R/utilities.r

@@ -11,6 +11,12 @@ standardize <- function(x) {
     attr(z,"scaled:scale") <- attr(x,"scaled:scale")
     return(z)
 }
+unstandardize <- function(x) {
+    scale <- attr(x,"scaled:scale")
+    center <- attr(x,"scaled:center")
+    z <- x*scale + center
+    return( as.numeric(z) )
+}
 
 # set help to html
 htmlhelp <- function() options(help_type="html")

tests/book_chapters/test_chapter04.R

@@ -1,5 +1,5 @@
 # test_dir('rethinking/tests/testthat')
-# test_dir('rethinking/tests/book_chapters',filter="chapter04")
+# test_dir('rethinking/tests/book_chapters',filter="chapter04", reporter="summary")
 
 context('chapter 4')
 library(rethinking)

tests/book_chapters/test_chapter09.R

@@ -95,16 +95,19 @@ test_that("R code 9.16",{
 
 ## R code 9.22
 y <- c(-1,1)
-set.seed(11)
-m9.2 <- ulam(
-    alist(
-        y ~ dnorm( mu , sigma ) ,
-        mu <- alpha ,
-        alpha ~ dnorm( 0 , 1000 ) ,
-        sigma ~ dexp( 0.0001 )
-    ) , data=list(y=y) , chains=3 )
-
 test_that("R code 9.22",{
+
+    set.seed(11)
+    expect_warning(
+    m9.2 <- ulam(
+        alist(
+            y ~ dnorm( mu , sigma ) ,
+            mu <- alpha ,
+            alpha ~ dnorm( 0 , 1000 ) ,
+            sigma ~ dexp( 0.0001 )
+        ) , data=list(y=y) , chains=3 )
+    )
+
     expect_equivalent( dim(precis(m9.2,2)) , c(2,6) )
     expect_equivalent( divergent(m9.2) , 67 )
 })
@@ -129,34 +132,40 @@ set.seed(41)
 y <- rnorm( 100 , mean=0 , sd=1 )
 
 ## R code 9.26
-set.seed(384)
-m9.4 <- ulam(
-    alist(
-        y ~ dnorm( mu , sigma ) ,
-        mu <- a1 + a2 ,
-        a1 ~ dnorm( 0 , 1000 ),
-        a2 ~ dnorm( 0 , 1000 ),
-        sigma ~ dexp( 1 )
-    ) , data=list(y=y) , chains=3 )
-
 test_that("R code 9.26",{
+    set.seed(384)
+    expect_warning( 
+    m9.4 <- ulam(
+        alist(
+            y ~ dnorm( mu , sigma ) ,
+            mu <- a1 + a2 ,
+            a1 ~ dnorm( 0 , 1000 ),
+            a2 ~ dnorm( 0 , 1000 ),
+            sigma ~ dexp( 1 )
+        ) , data=list(y=y) , chains=3 )
+    , NULL )
+
     expect_equivalent( dim(precis(m9.4,2)) , c(3,6) )
     expect_equivalent( divergent(m9.4) , 0 )
     expect_equivalent( round(precis(m9.4,2)$n_eff[1]) , 2 )
 })
 
 ## R code 9.27
-m9.5 <- ulam(
-    alist(
-        y ~ dnorm( mu , sigma ) ,
-        mu <- a1 + a2 ,
-        a1 ~ dnorm( 0 , 10 ),
-        a2 ~ dnorm( 0 , 10 ),
-        sigma ~ dexp( 1 )
-    ) , data=list(y=y) , chains=3 )
-
 test_that("R code 9.27",{
+
+    expect_warning(  
+    m9.5 <- ulam(
+        alist(
+            y ~ dnorm( mu , sigma ) ,
+            mu <- a1 + a2 ,
+            a1 ~ dnorm( 0 , 10 ),
+            a2 ~ dnorm( 0 , 10 ),
+            sigma ~ dexp( 1 )
+        ) , data=list(y=y) , chains=3 )
+    , "Bulk Effective" , fixed=TRUE )
+
     expect_equivalent( dim(precis(m9.5,2)) , c(3,6) )
     expect_equivalent( divergent(m9.5) , 0 )
+
 })
 

tests/book_chapters/test_chapter11.R

@@ -144,7 +144,7 @@ test_that("R code 11.21",{
 test_that("R code 11.22",{
     m11.4_stan_code <- stancode(m11.4)
     m11.4_stan <- stan( model_code=m11.4_stan_code , data=dat_list , chains=4 )
-    compare( m11.4_stan , m11.4 )
+    expect_warning( compare( m11.4_stan , m11.4 ) )
 })
 
 ## R code 11.24
@@ -371,9 +371,12 @@ model{
 
 ## R code 11.57
 dat_list <- list( N=N , K=3 , career=career , career_income=income )
-m11.13 <- stan( model_code=code_m11.13 , data=dat_list , chains=4 )
 
+expect_warning(
+        m11.13 <- stan( model_code=code_m11.13 , data=dat_list , chains=4 )
+    )
 test_that("R code 11.57",{
+
     expect_equivalent( dim( precis( m11.13 , 2 ) ) , c(3,6) )
 })
 

tests/book_chapters/test_chapter12.R

@@ -29,7 +29,7 @@ test_that("R code 12.2",{
 })
 
 ## R code 12.5
-postcheck( m12.1 )
+# postcheck( m12.1 )
 
 ## R code 12.6
 library(rethinking)

tests/book_chapters/test_chapter14.R

@@ -48,6 +48,7 @@ d <- data.frame( cafe=cafe_id , afternoon=afternoon , wait=wait )
 ## R code 14.12
 test_that("R code 14.12",{
     set.seed(867530)
+    expect_warning(
     m14.1 <- ulam(
         alist(
             wait ~ normal( mu , sigma ),
@@ -59,6 +60,7 @@ test_that("R code 14.12",{
             sigma ~ exponential(1),
             Rho ~ lkj_corr(2)
         ) , data=d , chains=4 , cores=4 )
+    )
     expect_equivalent( dim(precis(m14.1,3)) , c(49,6) )
 })
 
@@ -99,6 +101,7 @@ test_that("R code 14.18",{
 ## R code 14.19
 test_that("R code 14.19",{
     set.seed(4387510)
+    expect_warning(
     m14.3 <- ulam(
         alist(
             L ~ binomial(1,p),
@@ -123,6 +126,7 @@ test_that("R code 14.19",{
             gq> matrix[4,4]:Rho_actor <<- Chol_to_Corr(L_Rho_actor),
             gq> matrix[4,4]:Rho_block <<- Chol_to_Corr(L_Rho_block)
         ) , data=dat , chains=4 , cores=4 , log_lik=TRUE )
+    )
     expect_equivalent( dim(precis(m14.3,3)) , c(180,6) )
 })
 
@@ -167,6 +171,7 @@ test_that("R code 14.25",{
 
 ## R code 14.26
 test_that("R code 14.26",{
+    expect_warning(
     m14.6 <- ulam(
         alist(
             c(W,E) ~ multi_normal( c(muW,muE) , Rho , Sigma ),
@@ -177,6 +182,7 @@ test_that("R code 14.26",{
             Rho ~ lkj_corr( 2 ),
             Sigma ~ exponential( 1 )
         ), data=dat_sim , chains=4 , cores=4 )
+    )
     expect_equivalent( dim(precis(m14.6,3)) , c(10,6) )
 })
 
@@ -196,6 +202,7 @@ kl_data <- list(
 )
 
 test_that("R code 14.31",{
+    expect_warning(
     m14.7 <- ulam(
         alist(
             giftsAB ~ poisson( lambdaAB ),
@@ -219,6 +226,7 @@ test_that("R code 14.31",{
            ## compute correlation matrix for dyads
             gq> matrix[2,2]:Rho_d <<- Chol_to_Corr( L_Rho_d )
         ), data=kl_data , chains=4 , cores=4 , iter=2000 )
+    )
     expect_equivalent( dim(precis(m14.7,3)) , c(1266,6) )
 })
 
@@ -258,6 +266,7 @@ test_that("R code 14.39",{
 
 ## R code 14.46
 test_that("R code 14.46",{
+    expect_warning(
     m14.8nc <- ulam(
         alist(
             T ~ dpois(lambda),
@@ -273,6 +282,7 @@ test_that("R code 14.46",{
             etasq ~ dexp( 2 ),
             rhosq ~ dexp( 0.5 )
         ), data=dat_list , chains=4 , cores=4 , iter=2000 )
+    )
     expect_equivalent( dim(precis(m14.8nc,3)) , c(225,6) )
 })
 

tests/book_chapters/test_chapter15.R

@@ -175,6 +175,7 @@ test_that("R code 15.19",{
 
 ## R code 15.22
 test_that("R code 15.22",{
+    expect_warning(
     m15.7 <- ulam(
         alist(
            # K as function of B and M
@@ -195,6 +196,7 @@ test_that("R code 15.22",{
             Rho_BM ~ lkj_corr(2),
             Sigma_BM ~ dexp(1)
         ) , data=dat_list , chains=4 , cores=4 )
+    )
     expect_equivalent( dim(precis(m15.7,3)) , c(24,6) )
 })