Modifications to print to match previous output

3 files changed, 158 insertions, 110 deletions

diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index 5c67090..39efba7 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -1,14 +1,14 @@
-# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag.
-# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+#
+# NOTE: This workflow is overkill for most R packages and
+# check-standard.yaml is likely a better choice.
+# usethis::use_github_action("check-standard") will install it.
 on:
   push:
-    branches:
-      - main
-      - master
+    branches: [main, master]
   pull_request:
-    branches:
-      - main
-      - master
+    branches: [main, master]
 
 name: R-CMD-check
 
@@ -22,67 +22,32 @@ jobs:
       fail-fast: false
       matrix:
         config:
+          - {os: windows-latest, r: 'release'}
+          - {os: macOS-latest, r: 'release'}
           - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
           - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
           - {os: ubuntu-20.04, r: 'oldrel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
 
     env:
-      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
-      RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
 
-      - uses: r-lib/actions/setup-pandoc@v1
-
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Cache R packages
-        if: runner.os != 'Windows'
-        uses: actions/cache@v2
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install JAGS
-        run: |
-          sudo apt-get update -y
-          sudo apt-get install -y jags
-
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
-        run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
-
-      - name: Install dependencies
-        run: |
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
-
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_REMOTE_: false
-        run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--ignore-vignettes", "--no-build-vignettes", "--as-cran"), build_args = c("--no-manual", "--no-build-vignettes"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
+          extra-packages: any::rcmdcheck
+          needs: check
 
-      - name: Upload check results
-        if: failure()
-        uses: actions/upload-artifact@main
+      - uses: r-lib/actions/check-r-package@v2
         with:
-          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check
+          upload-snapshots: true
diff --git a/R/print.R b/R/print.R
index 1d3030d..bb593ec 100644
--- a/R/print.R
+++ b/R/print.R
@@ -1,76 +1,83 @@
 
 print.jagsUI <- function(x,digits=3,...){
-  
+
+  mc <- x$mcmc.info
+
+  # Header
   #bugs.format=TRUE prints a nearly exact replica of WinBUGS-style output
-  
-  #Header
-  if(!x$bugs.format){
-    cat('JAGS output for model \'',x$modfile,'\', generated by jagsUI.','\n',sep="")
-    cat('Estimates based on',x$mcmc.info$n.chains,'chains of',x$mcmc.info$n.iter,'iterations,\n') 
-    if(all(x$mcmc.info$sufficient.adapt)){cat('adaptation =',mean(x$mcmc.info$n.adapt),'iterations (sufficient),\n')
-      } else{cat('adaptation =',mean(x$mcmc.info$n.adapt),'iterations (possibly insufficient),\n')}
-    cat('burn-in = ',x$mcmc.info$n.burnin,' iterations and thin rate = ',x$mcmc.info$n.thin,',','\n',sep="")
-    cat('yielding',x$mcmc.info$n.samples,'total samples from the joint posterior.','\n')
-    if(!x$parallel){cat('MCMC ran for ',x$mcmc.info$elapsed.mins,' minutes at time ',paste(x$run.date),'.\n','\n',sep="")
-    } else{cat('MCMC ran in parallel for ',x$mcmc.info$elapsed.mins,' minutes at time ',paste(x$run.date),'.\n','\n',sep="")}
-  } else{
+  if(x$bugs.format){
     cat('Inference for Bugs model at \'',x$modfile,'\', fit using JAGS,','\n',sep="")
-    cat(x$mcmc.info$n.chains,'chains, each with',x$mcmc.info$n.iter,'iterations (first ',x$mcmc.info$n.burnin,'discarded), n.thin =',x$mcmc.info$n.thin) 
-    cat('\nn.sims =',x$mcmc.info$n.samples,'iterations saved','\n')    
-  }
-  
-  #Organize columns
-  if(!x$bugs.format){
-    if(x$mcmc.info$n.chains!=1){y = x$summary[,c(1,2,3,5,7,10,11,8,9)]
-    } else {y = x$summary[,c(1,2,3,5,7,8,9)]}
-    z <-  as.data.frame(round(as.matrix(y),digits))
-    if(is.vector(y)){
-      z <- as.data.frame(t(z))
-      row.names(z) <- rownames(x$summary)
-    }
-    z[,6] <- z[,6]==1
+    cat(mc$n.chains,'chains, each with',mc$n.iter,'iterations (first ',mc$n.burnin,'discarded), n.thin =',mc$n.thin) 
+    cat('\nn.sims =',mc$n.samples,'iterations saved','\n')  
   } else {
-    if(x$mcmc.info$n.chains!=1){y = x$summary[,c(1:9)]
-    } else {y = x$summary[,c(1:7)]}
-    z <- as.data.frame(round(as.matrix(y),digits))
-    if(is.vector(y)){
-      z <- as.data.frame(t(z))
-      row.names(z) <- rownames(x$summary)
+    cat('JAGS output for model \'',x$modfile,'\', generated by jagsUI.','\n',sep="")
+    cat('Estimates based on',mc$n.chains,'chains of',mc$n.iter,'iterations,\n') 
+    if(all(mc$sufficient.adapt)){
+      cat('adaptation =',mean(mc$n.adapt),'iterations (sufficient),\n')
+    } else{
+      cat('adaptation =',mean(mc$n.adapt),'iterations (possibly insufficient),\n')
+    }
+    cat('burn-in = ',mc$n.burnin,' iterations and thin rate = ',mc$n.thin,',','\n',sep="")
+    cat('yielding',mc$n.samples,'total samples from the joint posterior.','\n')
+    if(!x$parallel){
+      cat('MCMC ran for ',mc$elapsed.mins,' minutes at time ',paste(x$run.date),'.\n','\n',sep="")
+    } else{
+      cat('MCMC ran in parallel for ',mc$elapsed.mins,' minutes at time ',paste(x$run.date),'.\n','\n',sep="")
     }
   }
-  
-  #print the output
-  print(z)
-  
+
+  # Table
+  col_idx <- 1:ncol(x$summary)
+  if(x$bugs.format){
+    col_idx <- 1:9
+    if(mc$n.chains == 1) col_idx <- 1:7
+  } else {
+    col_idx <- c(1,2,3,5,7,10,11,8,9)
+    if(mc$n.chains == 1) col_idx <- c(1,2,3,5,7,10,11)
+  }
+  tab <- x$summary[,col_idx,drop=FALSE]
+  tab <- as.data.frame(round(tab, digits))
+  if(!x$bugs.format) tab[,"overlap0"] <- tab[,"overlap0"] == 1
+  print(tab)
+
   #Print Rhat/n.eff information if necessary
-  if(x$mcmc.info$n.chains>1){
-    if(!x$bugs.format){
-      if(max(unlist(x$Rhat),na.rm=TRUE)>1.1){cat('\n**WARNING** Rhat values indicate convergence failure.','\n')
-      }else{cat('\nSuccessful convergence based on Rhat values (all < 1.1).','\n')}
-      cat('Rhat is the potential scale reduction factor (at convergence, Rhat=1).','\n')
-      cat('For each parameter, n.eff is a crude measure of effective sample size.','\n')
-    } else {
+  if(mc$n.chains>1){
+    if(x$bugs.format){
       cat('\nFor each parameter, n.eff is a crude measure of effective sample size,','\n')
       cat('and Rhat is the potential scale reduction factor (at convergence, Rhat=1).','\n')
+    } else {
+      rhats <- unlist(tab[,"Rhat"])
+      if(any(is.na(rhats))){
+        cat('\n**WARNING** Some Rhat values could not be calculated.')
+      }
+      if(all(is.na(rhats))){
+        cat('\n')
+      } else if (max(rhats, na.rm=TRUE) > 1.1){
+        cat('\n**WARNING** Rhat values indicate convergence failure.','\n')
+      } else {
+        cat('\nSuccessful convergence based on Rhat values (all < 1.1).','\n')
+      }
+      cat('Rhat is the potential scale reduction factor (at convergence, Rhat=1).','\n')
+      cat('For each parameter, n.eff is a crude measure of effective sample size.','\n')
     }
   }
-  
+
   #Print overlap0/f statistic info
   if(!x$bugs.format){
-  cat('\noverlap0 checks if 0 falls in the parameter\'s 95% credible interval.\n')
-  cat('f is the proportion of the posterior with the same sign as the mean;\n')
-  cat('i.e., our confidence that the parameter is positive or negative.\n')
+    cat('\noverlap0 checks if 0 falls in the parameter\'s 95% credible interval.\n')
+    cat('f is the proportion of the posterior with the same sign as the mean;\n')
+    cat('i.e., our confidence that the parameter is positive or negative.\n')
   }
   
   #Print DIC info
   if(x$calc.DIC & !is.null(x$pD)){
-    if(!x$bugs.format){
-      cat('\nDIC info: (pD = var(deviance)/2)','\npD =',round(x$pD,1),'and DIC =',round(x$DIC,digits),'\n')
-      cat('DIC is an estimate of expected predictive error (lower is better).\n')
-    } else {
+    if(x$bugs.format){
       cat('\nDIC info (using the rule, pD = var(deviance)/2)','\npD =',round(x$pD,1),'and DIC =',round(x$DIC,digits),'\n')
       cat('DIC is an estimate of expected predictive error (lower deviance is better).\n')
-    }
+    } else {
+      cat('\nDIC info: (pD = var(deviance)/2)','\npD =',round(x$pD,1),'and DIC =',round(x$DIC,digits),'\n')
+      cat('DIC is an estimate of expected predictive error (lower is better).\n')
+    }  
   }
     
     
diff --git a/inst/tinytest/test_print.R b/inst/tinytest/test_print.R
new file mode 100644
index 0000000..a45e452
--- /dev/null
+++ b/inst/tinytest/test_print.R
@@ -0,0 +1,76 @@
+out <- readRDS("longley_reference_fit.Rds")
+
+# Check standard output
+pr <- capture.output(print(out))
+ref <- c("JAGS output for model '/tmp/RtmpfjJ4CS/fileba59500bfcfc', generated by jagsUI.",
+"Estimates based on 3 chains of 1000 iterations,", "adaptation = 100 iterations (sufficient),",
+"burn-in = 500 iterations and thin rate = 2,", "yielding 750 total samples from the joint posterior. ",
+"MCMC ran for 0.001 minutes at time 2023-12-02 19:31:22.886591.",
+"", "           mean    sd   2.5%    50%  97.5% overlap0 f  Rhat n.eff",
+"alpha    51.876 0.745 50.384 51.891 53.380    FALSE 1 1.000   750",
+"beta      0.035 0.002  0.031  0.035  0.038    FALSE 1 1.000   750",
+"sigma     0.728 0.154  0.506  0.700  1.102    FALSE 1 0.998   750",
+"mu[1]    59.997 0.340 59.323 60.002 60.680    FALSE 1 1.001   750",
+"mu[2]    60.869 0.302 60.275 60.873 61.461    FALSE 1 1.001   750",
+"mu[3]    60.821 0.304 60.221 60.825 61.418    FALSE 1 1.001   750",
+"mu[4]    61.741 0.267 61.234 61.741 62.263    FALSE 1 1.001   750",
+"mu[5]    63.280 0.218 62.872 63.276 63.704    FALSE 1 1.000   750",
+"mu[6]    63.904 0.204 63.504 63.900 64.306    FALSE 1 1.000   750",
+"mu[7]    64.542 0.195 64.158 64.536 64.933    FALSE 1 1.000   750",
+"mu[8]    64.463 0.195 64.078 64.458 64.857    FALSE 1 1.000   750",
+"mu[9]    65.654 0.193 65.279 65.655 66.027    FALSE 1 1.000   750",
+"mu[10]   66.407 0.203 66.021 66.406 66.802    FALSE 1 1.000   750",
+"mu[11]   67.224 0.221 66.797 67.226 67.641    FALSE 1 1.000   750",
+"mu[12]   67.286 0.223 66.854 67.287 67.704    FALSE 1 1.000   750",
+"mu[13]   68.609 0.266 68.098 68.613 69.142    FALSE 1 1.000   750",
+"mu[14]   69.298 0.293 68.739 69.301 69.867    FALSE 1 1.000   750",
+"mu[15]   69.838 0.316 69.229 69.844 70.443    FALSE 1 1.000   750",
+"mu[16]   71.111 0.373 70.383 71.111 71.820    FALSE 1 1.000   750",
+"deviance 33.463 2.889 30.084 32.649 41.260    FALSE 1 0.999   750",
+"", "Successful convergence based on Rhat values (all < 1.1). ",
+"Rhat is the potential scale reduction factor (at convergence, Rhat=1). ",
+"For each parameter, n.eff is a crude measure of effective sample size. ",
+"", "overlap0 checks if 0 falls in the parameter's 95% credible interval.",
+"f is the proportion of the posterior with the same sign as the mean;",
+"i.e., our confidence that the parameter is positive or negative.",
+"", "DIC info: (pD = var(deviance)/2) ", "pD = 4.2 and DIC = 37.647 ",
+"DIC is an estimate of expected predictive error (lower is better)."
+)
+expect_identical(pr, ref)
+
+# Rounded
+pr2 <- capture.output(print(out, digits=2))
+expect_equal(substr(pr2[9], 10,15), "51.88 ")
+
+# With bad Rhat
+out2 <- out
+out2$summary[1,"Rhat"] <- 1.2
+pr2 <- capture.output(print(out2))
+expect_true(grepl("convergence failure", pr2[30]))
+
+# With an NA rhat
+out2 <- out
+out2$summary[1,"Rhat"] <- NA
+pr2 <- capture.output(print(out2))
+expect_true(grepl("WARNING", pr2[30]))
+
+# With all NA rhats
+out2 <- out
+out2$summary[,"Rhat"] <- NA
+pr2 <- capture.output(print(out2))
+expect_true(grepl("WARNING", pr2[30]))
+
+# With 1 chain
+out2 <- out
+out2$mcmc.info$n.chains <- 1
+pr2 <- capture.output(print(out2))
+expect_false(grepl("Rhat", pr2[8]))
+expect_false(grepl("n.eff", pr2[8]))
+expect_true(grepl("overlap0", pr2[30]))
+
+# bugs.format
+out2 <- out
+out2$bugs.format <- TRUE
+pr2 <- capture.output(print(out2))
+expect_true(grepl("Bugs", pr2[1]))
+expect_true(grepl("and Rhat", pr2[27]))