greta-dev · njtierney · Mar 18, 2022 · Mar 21, 2022 · Mar 21, 2022 · Mar 21, 2022
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: greta
 Title: Simple and Scalable Statistical Modelling in R
-Version: 0.4.1.9000
-Date: 2022-03-14
+Version: 0.4.2.9000
+Date: 2022-03-22
 Authors@R: c(
     person("Nick", "Golding", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0001-8916-5570")),

diff --git a/NAMESPACE b/NAMESPACE
@@ -116,6 +116,8 @@ S3method(rowMeans,default)
 S3method(rowMeans,greta_array)
 S3method(rowSums,default)
 S3method(rowSums,greta_array)
+S3method(sd,default)
+S3method(sd,greta_array)
 S3method(sign,greta_array)
 S3method(simulate,greta_model)
 S3method(sin,greta_array)
@@ -232,6 +234,7 @@ export(rms_prop)
 export(rowMeans)
 export(rowSums)
 export(rwmh)
+export(sd)
 export(simplex_variable)
 export(slice)
 export(slsqp)

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,10 @@
-# greta 0.4.1.9000 (development version)
+# greta (development version)
+
+# greta 0.4.2
+
+## Fixes
+
+* workaround for M1 issues (#507)
 
 # greta 0.4.1 (2022-03-14)
 

diff --git a/R/checkers.R b/R/checkers.R
@@ -26,14 +26,14 @@ check_tf_version <- function(alert = c("none",
 
   if (is_mac_arm64()) {
 
-    msg <-  cli::format_error(
+    msg <-  cli::format_message(
       c(
         "{.pkg greta} does not currently work with Apple Silicon (M1)",
         "We are working on getting this resolved ASAP, see {.url https://github.com/greta-dev/greta/issues/458} for current progress."
       )
     )
 
-    stop(
+    message(
       msg,
       call. = FALSE
     )

diff --git a/R/functions.R b/R/functions.R
@@ -62,6 +62,7 @@
 #'  prod(..., na.rm = TRUE)
 #'  min(..., na.rm = TRUE)
 #'  max(..., na.rm = TRUE)
+#'  sd(..., na.rm = TRUE)
 #'
 #'  # cumulative operations
 #'  cumsum(x)
@@ -77,10 +78,10 @@
 #'
 #'  # miscellaneous operations
 #'  aperm(x, perm)
-#'  apply(x, MARGIN, FUN = c("sum", "max", "mean", "min",
+#'  apply(x, MARGIN, FUN = c("sum", "max", "mean", "min", "sd,
 #'                           "prod", "cumsum", "cumprod"))
 #'  sweep(x, MARGIN, STATS, FUN = c('-', '+', '/', '*'))
-#'  tapply(X, INDEX, FUN = c("sum", "max", "mean", "min", "prod"), ...)
+#'  tapply(X, INDEX, FUN = c("sum", "max", "mean", "min", "sd, "prod"), ...)
 #'
 #' }
 #'
@@ -590,6 +591,31 @@ mean.greta_array <- function(x, trim = 0, na.rm = TRUE, ...) { # nolint
   )
 }
 
+# need to define sd as a generic since it isn't actually a generic
+#' @rdname overloaded
+#' @export
+sd <- function(x, ...) UseMethod("sd", x)
+
+# setting default and setting arguments for it so it passes package check
+#' @export
+sd.default <- function(x, na.rm = FALSE, ...) {
+  sd_result <- stats::sd(x = x,
+                         na.rm = na.rm)
+  formals(sd.default) <- c(formals(sd.default), alist(... =))
+
+  sd_result
+}
+
+#' @export
+sd.greta_array <- function(x, na.rm = TRUE, ...) { # nolint
+
+  # calculate SD on greta array
+  op("sd", x,
+    dim = c(1, 1),
+    tf_operation = "tf_sd"
+  )
+}
+
 #' @export
 max.greta_array <- function(..., na.rm = TRUE) { # nolint
 
@@ -1073,7 +1099,7 @@ apply.default <- function(X, MARGIN, FUN, ...) { # nolint
 #' @export
 apply.greta_array <- function(X, MARGIN,
                               FUN = c(
-                                "sum", "max", "mean", "min", "prod",
+                                "sum", "max", "mean", "min", "sd", "prod",
                                 "cumsum", "cumprod"
                               ),
                               ...) {
@@ -1169,7 +1195,7 @@ tapply.default <- function(X, INDEX, FUN = NULL, ...,
 # nolint start
 #' @export
 tapply.greta_array <- function(X, INDEX,
-                               FUN = c("sum", "max", "mean", "min", "prod"),
+                               FUN = c("sum", "max", "mean", "min", "prod", "sd"),
                                ...) {
   # nolint end
 

diff --git a/R/tf_functions.R b/R/tf_functions.R
@@ -80,6 +80,27 @@ tf_mean <- function(x, drop = FALSE) {
   skip_dim("reduce_mean", x, drop)
 }
 
+# need to create a "reduce_sd" function
+# which
+
+tf_sd <- function(x, drop = FALSE){
+
+  n_dim <- length(dim(x))
+  reduction_dims <- seq_len(n_dim - 1)
+
+  # replace these parts with tf_sum and friends?
+  x_mean <- tf_mean(x, drop = drop)
+  x_sub <- x - x_mean
+  x_mean_sq <- x_sub * x_sub
+  total_ss <- tf_sum(x_mean_sq, drop = drop)
+  n_denom <- prod(dim(x)[reduction_dims + 1])
+  var <- total_ss / fl(n_denom - 1)
+  sd_result <- tf$math$sqrt(var)
+
+  sd_result
+}
+
+
 tf_max <- function(x, drop = FALSE) {
   skip_dim("reduce_max", x, drop)
 }

diff --git a/codemeta.json b/codemeta.json
@@ -6,8 +6,8 @@
   "name": "greta: Simple and Scalable Statistical Modelling in R",
   "codeRepository": "https://github.com/njtierney/greta",
   "issueTracker": "https://github.com/greta-dev/greta/issues",
-  "license": "Apache License 2",
-  "version": "0.4.1",
+  "license": "https://spdx.org/licenses/Apache-2.0",
+  "version": "0.4.2",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -515,7 +515,7 @@
     },
     "SystemRequirements": "Python (>= 2.7.0) with header files and shared\n    library; TensorFlow (v1.14; https://www.tensorflow.org/); TensorFlow\n    Probability (v0.7.0; https://www.tensorflow.org/probability/)"
   },
-  "fileSize": "1326.582KB",
+  "fileSize": "1320.891KB",
   "citation": [
     {
       "@type": "ScholarlyArticle",

diff --git a/cran-comments.md b/cran-comments.md
@@ -5,9 +5,10 @@
 
 ## R CMD check results
 
-0 errors | 0 warnings | 1 notes
+0 errors | 0 warnings | 0 notes
 
-* Maintainer has changed from Nick Golding to Nicholas Tierney.
+* Days since last update: 7
+* Package has been resubmitted based on request to fix error on install of M1. This has now been resolved
 
 ## revdepcheck results
 

diff --git a/man/functions.Rd b/man/functions.Rd
diff --git a/man/overloaded.Rd b/man/overloaded.Rd
diff --git a/tests/testthat/_snaps/check-m1.md b/tests/testthat/_snaps/check-m1.md
@@ -1,5 +1,8 @@
 # check_tf_version fails when M1 mac detected
 
-    greta does not currently work with Apple Silicon (M1)
-    We are working on getting this resolved ASAP, see <https://github.com/greta-dev/greta/issues/458> for current progress.
+    Code
+      check_tf_version("error")
+    Message <simpleMessage>
+      greta does not currently work with Apple Silicon (M1)
+      We are working on getting this resolved ASAP, see <https://github.com/greta-dev/greta/issues/458> for current progress.FALSE
 
diff --git a/tests/testthat/test-check-m1.R b/tests/testthat/test-check-m1.R
@@ -1,7 +1,8 @@
 test_that("check_tf_version fails when M1 mac detected", {
   skip_if_not(check_tf_version())
   withr::local_envvar("GRETA_M1_MESSAGE_TESTING" = "on")
-  expect_snapshot_error(
-    check_tf_version("error")
+  expect_snapshot(
+    x = check_tf_version("error"),
+    cnd_class = FALSE
   )
 })
diff --git a/tests/testthat/test_functions.R b/tests/testthat/test_functions.R
@@ -22,6 +22,7 @@ test_that("simple functions work as expected", {
   check_op(mean, x)
   check_op(sqrt, exp(x))
   check_op(sign, x)
+  check_op(sd, x)
 
   # rounding of numbers
   check_op(ceiling, x)
@@ -230,6 +231,7 @@ test_that("apply works as expected", {
     check_apply(a, margin, "prod")
     check_apply(a, margin, "cumsum")
     check_apply(a, margin, "cumprod")
+    check_apply(a, margin, "sd")
   }
 })
 
@@ -243,6 +245,7 @@ test_that("tapply works as expected", {
   check_expr(tapply(x, rep(1:5, each = 3), "mean"))
   check_expr(tapply(x, rep(1:5, each = 3), "min"))
   check_expr(tapply(x, rep(1:5, each = 3), "prod"))
+  check_expr(tapply(x, rep(1:5, each = 3), "sd"))
 })
 
 test_that("cumulative functions error as expected", {