WIP: Check for performance improvements with C++

.pre-commit-config.yaml

@@ -24,6 +24,10 @@ repos:
         - r-lib/pkgapi
         - [email protected]
         - [email protected]
+        - pkgbuild
+        - brio
+        - decor
+        - cpp11
     -   id: use-tidy-description
     -   id: spell-check
         exclude: >
@@ -43,6 +47,9 @@ repos:
           (.*/|)\.pre-commit-.*|
           .*\.[rR]|
           .*\.Rproj|
+          .*\.cpp|
+          .*\.h|
+          .*\.hpp|
           .*\.py|
           .*\.feather|
           .*\.rds|

DESCRIPTION

@@ -59,6 +59,7 @@ Collate:
     'communicate.R'
     'compat-dplyr.R'
     'compat-tidyr.R'
+    'cpp11.R'
     'detect-alignment-utils.R'
     'detect-alignment.R'
     'environments.R'
@@ -103,3 +104,6 @@ Collate:
     'vertical.R'
     'visit.R'
     'zzz.R'
+LinkingTo: 
+    cpp11
+SystemRequirements: C++11

NAMESPACE

@@ -46,3 +46,4 @@ importFrom(rlang,with_handlers)
 importFrom(utils,capture.output)
 importFrom(utils,tail)
 importFrom(utils,write.table)
+useDynLib(styler, .registration = TRUE)

R/addins.R

@@ -72,7 +72,7 @@ style_active_file <- function() {
   }
   rstudioapi::modifyRange(
     c(1L, 1L, length(context$contents) + 1L, 1L),
-    paste0(ensure_last_n_empty(out), collapse = "\n"),
+    paste0(ensure_last_n_empty(out, n = 1L), collapse = "\n"),
     id = context$id
   )
   if (save_after_styling_is_active() == TRUE && context$path != "") {

R/cpp11.R

@@ -0,0 +1,9 @@
+# Generated by cpp11: do not edit by hand
+
+ensure_last_n_empty <- function(x, n) {
+  .Call(`_styler_ensure_last_n_empty`, x, n)
+}
+
+line_col_names <- function() {
+  .Call(`_styler_line_col_names`)
+}

R/styler.R

@@ -18,6 +18,11 @@
 #' style_text("a%>%b; a", scope = "tokens")
 "_PACKAGE"
 
+## usethis namespace: start
+#' @useDynLib styler, .registration = TRUE
+## usethis namespace: end
+NULL
+
 if (getRversion() >= "2.15.1") {
   utils::globalVariables(c(
     ".",

R/utils.R

@@ -1,24 +1,5 @@
 parse_text <- function(x) parse_safely(x)[[1L]]
 
-line_col_names <- function() {
-  c("line1", "line2", "col1", "col2")
-}
-
-#' Ensure there is one (and only one) blank line at the end of a vector
-#' @examples
-#' styler:::ensure_last_n_empty("")
-#' styler:::ensure_last_n_empty(letters)
-#' styler:::ensure_last_n_empty(c(letters, "", "", ""))
-#' @keywords internal
-ensure_last_n_empty <- function(x, n = 1) {
-  if (all(x == "")) {
-    return("")
-  }
-  x <- c(x, "", "")
-  x <- x[seq(1, length(x) - which(rev(x) != "")[1] + 1L)]
-  c(x, rep("", n))
-}
-
 #' Replace the newline character with a line break
 #'
 #' @param text A character vector

inst/WORDLIST

@@ -15,6 +15,8 @@ benchmarking
 biocthis
 bootswatch
 BugReports
+CallEntries
+CallMethodDef
 cancelling
 cff
 chnages
@@ -26,6 +28,7 @@ coercible
 compat
 config
 CONST
+const
 coventions
 covr
 cpp
@@ -40,6 +43,9 @@ desc
 dev
 devtools
 dir
+DL
+dll
+DllInfo
 docsearch
 dont
 dontrun
@@ -62,10 +68,13 @@ examplesIf
 exampletestr
 expr
 expr EQ
+extern
 fileext
 filetype
+forceSymbols
 forcond
 formatter
+FUNC
 funct
 gadenbuie
 gcc
@@ -81,6 +90,7 @@ grkstyle
 GSOC
 hashFiles
 helpfiles
+hpp
 href
 http
 https
@@ -89,8 +99,10 @@ ifelse
 impl
 Indrajeet
 infinitively
+init
 initializer
 inode
+inserter
 integrations
 interaces
 invasiveness
@@ -112,6 +124,7 @@ LF
 LIBS
 lifecycle
 Ligges
+LinkingTo
 lintr
 linux
 lorenz
@@ -161,13 +174,15 @@ purrr
 qmd
 Qmd
 questionr
+rbegin
 rcmdcheck
 RcppExports
 rds
 readline
 readme
 README
 rebased
+registerRoutines
 reindent
 reindented
 reindention
@@ -217,6 +232,8 @@ sessioninfo
 setCacheRootPath
 setdiff
 setenv
+sexp
+SEXP
 shinydashboardPlus
 shinymeta
 shinyMonacoEditor
@@ -241,6 +258,7 @@ Sys
 sysreq
 sysreqs
 systemPipeShiny
+SystemRequirements
 tempfile
 testthat
 tibble
@@ -268,6 +286,7 @@ unnest
 unparsable
 unstyled
 upsetjs
+useDynamicSymbols
 usethis
 utf
 Uwe

src/.gitignore

@@ -0,0 +1,3 @@
+*.dll
+*.o
+*.so

src/cpp11.cpp

@@ -0,0 +1,35 @@
+// Generated by cpp11: do not edit by hand
+// clang-format off
+
+
+#include "cpp11/declarations.hpp"
+#include <R_ext/Visibility.h>
+
+// ensure_last_n_empty.cpp
+std::vector<std::string> ensure_last_n_empty(std::vector<std::string> x, int n);
+extern "C" SEXP _styler_ensure_last_n_empty(SEXP x, SEXP n) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(ensure_last_n_empty(cpp11::as_cpp<cpp11::decay_t<std::vector<std::string>>>(x), cpp11::as_cpp<cpp11::decay_t<int>>(n)));
+  END_CPP11
+}
+// line_col_names.cpp
+std::vector<std::string> line_col_names();
+extern "C" SEXP _styler_line_col_names() {
+  BEGIN_CPP11
+    return cpp11::as_sexp(line_col_names());
+  END_CPP11
+}
+
+extern "C" {
+static const R_CallMethodDef CallEntries[] = {
+    {"_styler_ensure_last_n_empty", (DL_FUNC) &_styler_ensure_last_n_empty, 2},
+    {"_styler_line_col_names",      (DL_FUNC) &_styler_line_col_names,      0},
+    {NULL, NULL, 0}
+};
+}
+
+extern "C" attribute_visible void R_init_styler(DllInfo* dll){
+  R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+  R_useDynamicSymbols(dll, FALSE);
+  R_forceSymbols(dll, TRUE);
+}

src/ensure_last_n_empty.cpp

@@ -0,0 +1,36 @@
+#include <cpp11.hpp>
+#include <string>
+#include <vector>
+#include <algorithm>
+using namespace cpp11;
+
+//' Ensure there is one (and only one) blank line at the end of a vector
+//' @examples
+//' styler:::ensure_last_n_empty("")
+//' styler:::ensure_last_n_empty(letters)
+//' styler:::ensure_last_n_empty(c(letters, "", "", ""))
+//' @keywords internal
+[[cpp11::register]]
+std::vector<std::string> ensure_last_n_empty(std::vector<std::string> x, int n = 1)
+{
+
+  // Return early if all elements are empty
+  // There should be only single empty element, no matter the value of `n`
+  if (std::all_of(x.begin(), x.end(), [](std::string s) { return s == ""; }))
+  {
+    std::vector<std::string> x{""};
+    return x;
+  }
+
+  // If an empty element isn't found at the end, add `n` of them
+  if (x.back() != "" && n > 0)
+  {
+    std::fill_n(std::back_inserter(x), n, "");
+    return x;
+  }
+
+  auto it = std::find_if(x.rbegin(), x.rend(), [](std::string s) { return s != ""; });
+  x.erase(it.base(), x.end());
+  std::fill_n(std::back_inserter(x), n, "");
+  return x;
+}

src/line_col_names.cpp

@@ -0,0 +1,10 @@
+#include <cpp11.hpp>
+#include <string>
+#include <vector>
+using namespace cpp11;
+[[cpp11::register]]
+std::vector<std::string> line_col_names()
+{
+  std::vector<std::string> x{"line1", "line2", "col1", "col2"};
+  return x;
+}

tests/testthat/test-varia.R

@@ -2,15 +2,15 @@
 
 test_that("ensure_last_n_empty", {
   expect_equal(
-    ensure_last_n_empty("x"),
+    ensure_last_n_empty("x", 1L),
     c("x", "")
   )
   expect_equal(
-    ensure_last_n_empty(c("x", "")),
+    ensure_last_n_empty(c("x", ""), 1L),
     c("x", "")
   )
   expect_equal(
-    ensure_last_n_empty(c("1", "2")),
+    ensure_last_n_empty(c("1", "2"), 1L),
     c("1", "2", "")
   )
 })

touchstone/script.R

@@ -1,5 +1,7 @@
 library(touchstone)
 
+number_of_runs <- 30L
+
 branch_install()
 
 clear_branch_caches <- function() {
@@ -18,7 +20,7 @@ benchmark_run(
     cache_deactivate()
   },
   without_cache = style_pkg("touchstone/sources/here", filetype = c("R", "rmd")),
-  n = 30
+  n = number_of_runs
 )
 
 clear_branch_caches()
@@ -28,7 +30,7 @@ benchmark_run(
     cache_activate(gert::git_branch())
   },
   cache_applying = style_pkg("touchstone/sources/here", filetype = c("R", "rmd")),
-  n = 30
+  n = number_of_runs
 )
 
 clear_branch_caches()
@@ -42,7 +44,7 @@ benchmark_run(
     gert::git_reset_hard(repo = "touchstone/sources/here")
     style_pkg("touchstone/sources/here", filetype = c("R", "rmd"))
   },
-  n = 30
+  n = number_of_runs
 )
 
 clear_branch_caches()