Merge pull request #2 from edahelsinki/development

Cleanup, formulas & documentation website

.Rbuildignore

@@ -3,8 +3,14 @@
 ^.*\.Rcheck$
 ^\.vscode$
 ^experiments$
+^tests$
+^docs$
 ^.*.zip
 ^.*.tar.gz
 ^\.lintr$
 ^CITATIONS.bib$
 ^\.github$
+^_pkgdown\.yml$
+^pkgdown$
+^doc$
+^pdfs$

.github/workflows/pkgdown.yaml

@@ -0,0 +1,46 @@
+# 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:
+    branches: [main, master]
+  # pull_request:
+  #   branches: [main, master]
+  # release:
+  #   types: [published]
+  workflow_dispatch:
+
+name: docs
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    # Only restrict concurrency for non-PR jobs
+    concurrency:
+      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::pkgdown, local::.
+          needs: website
+
+      - name: Build site
+        run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+        shell: Rscript {0}
+
+      - name: Deploy to GitHub pages 🚀
+        if: github.event_name != 'pull_request'
+        uses: JamesIves/github-pages-deploy-action@v4.4.1
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

.github/workflows/r_check.yml

@@ -1,10 +1,15 @@
 # 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:
+    branches: [main, master]
+    paths: ['R/*.R', 'tests/*.R', 'tests/testthat/*.R', 'src/*.cpp', 'src/*.h']
   pull_request:
     branches: [main, master]
+    paths: ['R/*.R', 'tests/*.R', 'tests/testthat/*.R', 'src/*.cpp', 'src/*.h']
+  workflow_dispatch:
 
-name: R-CMD-check
+name: tests
 
 jobs:
   R-CMD-check:

.gitignore

@@ -12,7 +12,6 @@ __pycache__
 *ACLiC*
 .Rproj.user
 *Rproj
-r/*.html
 *.RData
 *.Rcheck
 *.aux
@@ -21,24 +20,20 @@ r/*.html
 *.fdb_latexmk
 *.pdf
 *.synctex.*
-*.nb.html
+*.nb.*
 .Rhistory
 .Rapp.history
 .RData
 *-Ex.R
 /*.tar.gz
 /*.Rcheck/
-vignettes/*.html
-vignettes/*.pdf
 .httr-oauth
 /*_cache/
 /cache/
 *.utf8.md
 *.knit.md
 rsconnect/
 experiments/results/*
-!experiments/results/*.png
-!experiments/results/*.jpg
 experiments/data/*
 !experiments/data/*.r
 !experiments/data/*.R
@@ -49,13 +44,11 @@ tmp
 *.html
 *.zip
 *.tar.gz
-
 *~
 *.~
 todo.md
 *.dll
 data/*
 log*.txt
-!vignettes/paper.pdf
-!vignettes/presentation.pdf
-!vignettes/poster.pdf
+docs
+!pdfs/*.pdf

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: slise
 Title: Sparse Linear Subset Explanations
-Version: 2.0.0
+Version: 2.1.0
 Authors@R: c(
     person("Anton", "Björklund", email = "anton.bjorklund@helsinki.fi", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7749-2918")),
     person("Andreas", "Henelius", role = "aut", comment = c(ORCID = "0000-0002-4040-6967")),
@@ -11,8 +11,7 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Imports: lbfgs, stats, utils, methods, graphics, base
-Suggests: ggplot2, grid, gridExtra, reshape2, wordcloud, testthat, numDeriv, R.rsp
+Suggests: ggplot2, grid, gridExtra, reshape2, wordcloud, testthat, numDeriv
 URL: https://github.com/edahelsinki/slise
 LinkingTo: Rcpp, RcppArmadillo
 RoxygenNote: 7.1.1
-VignetteBuilder: R.rsp

NAMESPACE

@@ -3,13 +3,15 @@
 S3method(plot,slise)
 S3method(predict,slise)
 S3method(print,slise)
+export(auto_named_list)
 export(graduated_optimisation)
 export(scale_robust)
 export(simple_pca)
 export(slise.explain)
 export(slise.explain_comb)
 export(slise.explain_find)
 export(slise.fit)
+export(slise.formula)
 export(slise_initialisation_candidates)
 export(slise_initialisation_candidates2)
 export(slise_initialisation_lasso)
@@ -21,9 +23,13 @@ importFrom(stats,.lm.fit)
 importFrom(stats,lm.wfit)
 importFrom(stats,mad)
 importFrom(stats,median)
+importFrom(stats,model.frame)
+importFrom(stats,model.matrix)
+importFrom(stats,model.response)
 importFrom(stats,predict)
 importFrom(stats,quantile)
 importFrom(stats,sd)
+importFrom(stats,setNames)
 importFrom(stats,uniroot)
 importFrom(utils,combn)
 useDynLib(slise)

R/RcppExports.R

@@ -1,43 +1,43 @@
-# Generated by using Rcpp::compileAttributes() -> do not edit by hand
-# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
-
-sigmoidc <- function(x) {
-    .Call('_slise_sigmoidc', PACKAGE = 'slise', x)
-}
-
-log_sigmoidc <- function(x) {
-    .Call('_slise_log_sigmoidc', PACKAGE = 'slise', x)
-}
-
-loss_smooth_c <- function(alpha, data, response, epsilon, beta, lambda1, lambda2, weight) {
-    .Call('_slise_loss_smooth_c', PACKAGE = 'slise', alpha, data, response, epsilon, beta, lambda1, lambda2, weight)
-}
-
-loss_smooth_c_dc <- function(xs, dcptr) {
-    .Call('_slise_loss_smooth_c_dc', PACKAGE = 'slise', xs, dcptr)
-}
-
-loss_smooth_grad_c <- function(alpha, data, response, epsilon, beta, lambda1, lambda2, weight) {
-    .Call('_slise_loss_smooth_grad_c', PACKAGE = 'slise', alpha, data, response, epsilon, beta, lambda1, lambda2, weight)
-}
-
-loss_smooth_grad_c_dc <- function(xs, dcptr) {
-    .Call('_slise_loss_smooth_grad_c_dc', PACKAGE = 'slise', xs, dcptr)
-}
-
-lg_combined_smooth_c_dc <- function(xs, dcptr) {
-    .Call('_slise_lg_combined_smooth_c_dc', PACKAGE = 'slise', xs, dcptr)
-}
-
-lg_getgrad_c_dc <- function(xs, dcptr) {
-    .Call('_slise_lg_getgrad_c_dc', PACKAGE = 'slise', xs, dcptr)
-}
-
-loss_smooth_c_ptr <- function() {
-    .Call('_slise_loss_smooth_c_ptr', PACKAGE = 'slise')
-}
-
-loss_smooth_grad_c_ptr <- function() {
-    .Call('_slise_loss_smooth_grad_c_ptr', PACKAGE = 'slise')
-}
-
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+sigmoidc <- function(x) {
+    .Call('_slise_sigmoidc', PACKAGE = 'slise', x)
+}
+
+log_sigmoidc <- function(x) {
+    .Call('_slise_log_sigmoidc', PACKAGE = 'slise', x)
+}
+
+loss_smooth_c <- function(alpha, data, response, epsilon, beta, lambda1, lambda2, weight) {
+    .Call('_slise_loss_smooth_c', PACKAGE = 'slise', alpha, data, response, epsilon, beta, lambda1, lambda2, weight)
+}
+
+loss_smooth_c_dc <- function(xs, dcptr) {
+    .Call('_slise_loss_smooth_c_dc', PACKAGE = 'slise', xs, dcptr)
+}
+
+loss_smooth_grad_c <- function(alpha, data, response, epsilon, beta, lambda1, lambda2, weight) {
+    .Call('_slise_loss_smooth_grad_c', PACKAGE = 'slise', alpha, data, response, epsilon, beta, lambda1, lambda2, weight)
+}
+
+loss_smooth_grad_c_dc <- function(xs, dcptr) {
+    .Call('_slise_loss_smooth_grad_c_dc', PACKAGE = 'slise', xs, dcptr)
+}
+
+lg_combined_smooth_c_dc <- function(xs, dcptr) {
+    .Call('_slise_lg_combined_smooth_c_dc', PACKAGE = 'slise', xs, dcptr)
+}
+
+lg_getgrad_c_dc <- function(xs, dcptr) {
+    .Call('_slise_lg_getgrad_c_dc', PACKAGE = 'slise', xs, dcptr)
+}
+
+loss_smooth_c_ptr <- function() {
+    .Call('_slise_loss_smooth_c_ptr', PACKAGE = 'slise')
+}
+
+loss_smooth_grad_c_ptr <- function() {
+    .Call('_slise_loss_smooth_grad_c_ptr', PACKAGE = 'slise')
+}
+

R/data.R

@@ -13,7 +13,7 @@ add_intercept_column <- function(x) {
 }
 
 remove_intercept_column <- function(x) {
-    x2 <- x[, -1]
+    x2 <- x[, -1, drop = FALSE]
     attr(x2, "scaled:center") <- attr(x, "scaled:center")
     attr(x2, "scaled:scale") <- attr(x, "scaled:scale")
     attr(x2, "constant_columns") <- attr(x, "constant_columns")
@@ -47,7 +47,7 @@ add_constant_columns <- function(x, columns) {
     }
 }
 
-unscale_alpha <- function(alpha, x_center, x_scale, y_center=NULL, y_scale=NULL) {
+unscale_alpha <- function(alpha, x_center, x_scale, y_center = NULL, y_scale = NULL) {
     if (is.null(y_center) && is.null(y_scale)) {
         if (!hasattr(x_scale, "scaled:scale") && !hasattr(x_center, "scaled:scale")) {
             stop("X and Y must have the scaled attributes")
@@ -100,6 +100,30 @@ scale_robust <- function(x, th = .Machine$double.eps) {
     x
 }
 
+#' Unscale a scaled matrix / vector
+#'
+#' @param x the matrix / vector to unscale
+#' @param scaled optional object with "scaled:..." attributes
+#'
+#' @return x unscaled
+#'
+unscale <- function(x, scaled = NULL) {
+    if (is.null(scaled)) {
+        scaled <- x
+    }
+    center <- attr(scaled, "scaled:center")
+    scale <- attr(scaled, "scaled:scale")
+    if (is.null(dim(x))) { # Vector
+        x <- x * scale + center
+    } else { # Matrix
+        x <- sweep(x, 2, scale, `*`)
+        x <- sweep(x, 2, center, `+`)
+    }
+    attr(x, "scaled:center") <- NULL
+    attr(x, "scaled:scale") <- NULL
+    x
+}
+
 
 #' A variant of `scale` that only adds the attributes
 #'
@@ -113,7 +137,7 @@ scale_identity <- function(x) {
     x
 }
 
-scale_same <- function(x, center=NULL, scale=NULL, constant_columns=NULL) {
+scale_same <- function(x, center = NULL, scale = NULL, constant_columns = NULL) {
     if (is.null(center)) {
         return(x)
     }
@@ -163,4 +187,4 @@ simple_pca <- function(X, dimensions, tolerance = 1e-10) {
     }
     # Return the rotation matrix (only)
     pca_rotation
-}
+}