Merge pull request #16 from bsaul/style-lint

Style and lint package
bsaul · May 1, 2024 · bdd0061 · bdd0061
2 parents e6a993b + 4bd2817
commit bdd0061
Show file tree

Hide file tree

Showing 12 changed files with 312 additions and 227 deletions.
diff --git a/.github/workflows/style.yaml b/.github/workflows/style.yaml
@@ -0,0 +1,75 @@
+# 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
+on:
+  push:
+    paths: ["**.[rR]", "**.[qrR]md", "**.[rR]markdown", "**.[rR]nw", "**.[rR]profile"]
+
+name: Style
+
+jobs:
+  style:
+    runs-on: ubuntu-latest
+    permissions:
+      contents: write
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 0
+
+      - name: Setup R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: Install dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::styler, any::roxygen2
+          needs: styler
+
+      - name: Enable styler cache
+        run: styler::cache_activate()
+        shell: Rscript {0}
+
+      - name: Determine cache location
+        id: styler-location
+        run: |
+          cat(
+            "location=",
+            styler::cache_info(format = "tabular")$location,
+            "\n",
+            file = Sys.getenv("GITHUB_OUTPUT"),
+            append = TRUE,
+            sep = ""
+          )
+        shell: Rscript {0}
+
+      - name: Cache styler
+        uses: actions/cache@v4
+        with:
+          path: ${{ steps.styler-location.outputs.location }}
+          key: ${{ runner.os }}-styler-${{ github.sha }}
+          restore-keys: |
+            ${{ runner.os }}-styler-
+            ${{ runner.os }}-
+
+      - name: Style
+        run: styler::style_pkg()
+        shell: Rscript {0}
+
+      - name: Commit and push changes
+        run: |
+          if FILES_TO_COMMIT=($(git diff-index --name-only ${{ github.sha }} \
+              | egrep --ignore-case '\.(R|[qR]md|Rmarkdown|Rnw|Rprofile)$'))
+          then
+            git config --local user.name "$GITHUB_ACTOR"
+            git config --local user.email "[email protected]"
+            git commit ${FILES_TO_COMMIT[*]} -m "Style code (GHA)"
+            git pull --ff-only
+            git push origin
+          else
+            echo "No changes to commit."
+          fi
diff --git a/R/mean_var.R b/R/mean_var.R
@@ -8,7 +8,7 @@ NULL
 #' @param p a vector of proportions corresponding to the proportion in each group
 #' @return a covariance matrix
 #' @keywords internal
-multinom_var <- function(p){
+multinom_var <- function(p) {
   diag(p) - outer(p, p)
 }
 
@@ -26,184 +26,183 @@ multinom_var <- function(p){
 #' @importFrom methods setGeneric setMethod
 #' @return a list containing \code{mean} and \code{var}
 #' @keywords internal
-setGeneric("n_mean_var", def = function(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE){
+setGeneric("n_mean_var", def = function(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) {
   standardGeneric("n_mean_var")
 })
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("numeric", "missing"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
-    if(na.rm == TRUE){
+  f = "n_mean_var",
+  signature = c("numeric", "missing"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
+    if (na.rm == TRUE) {
       x <- stats::na.omit(x)
     }
 
-    n    <- length(x)
-    mean <- sum(x)/n
-    
+    n <- length(x)
+    mean <- sum(x) / n
+
     list(
       n    = n,
       mean = mean,
-      var  = sum((x - mean)^2)/n
+      var  = sum((x - mean)^2) / n
     )
-} )
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("numeric", "numeric"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
-    if(na.rm == TRUE){
+  f = "n_mean_var",
+  signature = c("numeric", "numeric"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
+    if (na.rm == TRUE) {
       kp <- !is.na(x)
       w <- w[kp]
       x <- x[kp]
     }
 
-    if(length(x) != length(w)){
+    if (length(x) != length(w)) {
       stop("x and w must have same length")
     }
 
-    xw   <- x * w
-    n    <- sum(w)
+    xw <- x * w
+    n <- sum(w)
 
     # Handle case were sum of weights is 0
-    if(n == 0){
-      mean = 0
-      var = 0
-    } else if(unwgt.var == TRUE){
-      mean = sum(xw)/n
-      unwgt_n = length(x)
-      unwgt_mean = sum(x)/unwgt_n
-      var = sum((x - unwgt_mean)^2)/unwgt_n
+    if (n == 0) {
+      mean <- 0
+      var <- 0
+    } else if (unwgt.var == TRUE) {
+      mean <- sum(xw) / n
+      unwgt_n <- length(x)
+      unwgt_mean <- sum(x) / unwgt_n
+      var <- sum((x - unwgt_mean)^2) / unwgt_n
     } else {
-      mean = sum(xw)/n
-      var = sum(w*(x - mean)^2)/n
+      mean <- sum(xw) / n
+      var <- sum(w * (x - mean)^2) / n
     }
 
     list(
       n    = n,
       mean = mean,
       var  = var
     )
-})
+  }
+)
 
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("integer", "missing"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
+  f = "n_mean_var",
+  signature = c("integer", "missing"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
     check_for_two_levels(x)
     n_mean_var(x = as.numeric(x), na.rm = na.rm, unwgt.var = unwgt.var)
-})
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("integer", "numeric"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
+  f = "n_mean_var",
+  signature = c("integer", "numeric"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
     check_for_two_levels(x)
     n_mean_var(x = as.numeric(x), w = w, na.rm = na.rm, unwgt.var = unwgt.var)
-})
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("logical", "missing"),
-  definition = function(x, na.rm = FALSE, unwgt.var = TRUE){
+  f = "n_mean_var",
+  signature = c("logical", "missing"),
+  definition = function(x, na.rm = FALSE, unwgt.var = TRUE) {
     n_mean_var(x = as.numeric(x), na.rm = na.rm, unwgt.var = unwgt.var)
-})
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("logical", "numeric"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
+  f = "n_mean_var",
+  signature = c("logical", "numeric"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
     n_mean_var(x = as.numeric(x), w = w, na.rm = na.rm, unwgt.var = unwgt.var)
-})
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("factor", "missing"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
-    if(na.rm == TRUE){
+  f = "n_mean_var",
+  signature = c("factor", "missing"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
+    if (na.rm == TRUE) {
       x <- stats::na.omit(x)
     }
 
     p <- prop.table(table(x))
     list(n = length(x), mean = p, var = multinom_var(p))
-})
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("factor", "numeric"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
-    if(na.rm == TRUE){
+  f = "n_mean_var",
+  signature = c("factor", "numeric"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
+    if (na.rm == TRUE) {
       kp <- !is.na(x)
       w <- w[kp]
       x <- x[kp]
     }
-    
+
     n <- sum(w)
-    p <- tapply(w, x, function(r) if(n == 0) 0 else sum(r)/n, default = 0)
-    if(unwgt.var == TRUE){
-      unwt_p <- prop.table(table(x)) #for unweighted variance
+    p <- tapply(w, x, function(r) if (n == 0) 0 else sum(r) / n, default = 0)
+    if (unwgt.var == TRUE) {
+      unwt_p <- prop.table(table(x)) # for unweighted variance
       var <- multinom_var(unwt_p)
     } else {
-      var = multinom_var(p)
+      var <- multinom_var(p)
     }
 
     list(n = n, mean = p, var = var)
-  })
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("character", "missing"),
-  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE){
-
-    if(na.rm == TRUE){
+  f = "n_mean_var",
+  signature = c("character", "missing"),
+  definition = function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
+    if (na.rm == TRUE) {
       x <- stats::na.omit(x)
     }
 
     x <- as.factor(x)
 
-    if(nlevels(x) > 50){
+    if (nlevels(x) > 50) {
       warning("x has more than 50 levels. Are you sure you meant for this?")
     }
 
     n_mean_var(x)
-})
+  }
+)
 
 #' @rdname n_mean_var
 setMethod(
-  f          = "n_mean_var",
-  signature  = c("character", "numeric"),
-  definition = function(x, w, na.rm = TRUE, unwgt.var = TRUE){
-
-    if(na.rm == TRUE){
+  f = "n_mean_var",
+  signature = c("character", "numeric"),
+  definition = function(x, w, na.rm = TRUE, unwgt.var = TRUE) {
+    if (na.rm == TRUE) {
       kp <- !is.na(x)
       w <- w[kp]
       x <- x[kp]
     }
 
     x <- as.factor(x)
 
-    if(nlevels(x) > 50){
+    if (nlevels(x) > 50) {
       warning("x has more than 50 levels. Are you sure you meant for this?")
     }
 
     n_mean_var(x, w, unwgt.var = unwgt.var)
-})
-
-
-
+  }
+)