Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Build a RStudio addin to debug pipe chains

I wrote a function that helps executing pipe chains step by step.

To use it the users has to copy the instruction to clipboard, then execute the function, and move to the console to proceed.

I would like to build an addin that would allow me to select the instructions and run the function with Ctrl + P without the awkward steps.

Ideally, the addin would :

  1. capture the selection
  2. run the function
  3. move the cursor to the console
  4. be triggered by Ctrl + P

I believe it's extremely similar to what the reprex addin is doing but I don't know where to start as I'm 100% new to addins.

I looked into rstudioapi::getActiveDocumentContext() but there was nothing there of interest to me.

How can I make this work ?

The function

debug_pipe <- function(.expr){
  .pchain <-
    if (missing(.expr)) readClipboard() # windows only , else try clipr::read_clip()
  else deparse(substitute(.expr))

  .lhs    <- if (grepl("^\\s*[[:alnum:]_.]*\\s*<-",.pchain[1])) {
    sub("^\\s*([[:alnum:]_.]*)\\s*<-.*","\\1",.pchain[1]) 
  } else NA

  .pchain <- sub("[^%]*<-\\s*","",.pchain)        # remove lhs of assignment if exists
  .pchain <- paste(.pchain,collapse = " ")          # collapse 
  .pchain <- gsub("\\s+"," ",.pchain)             # multiple spaces to single 
  .pchain <- strsplit(.pchain,"\\s*%>%\\s*")[[1]] # split by pipe
  .pchain <- as.list(.pchain)

  for (i in rev(seq_along(.pchain))) {
    # function to count matches
    .f <- function(x) sum(gregexpr(x,.pchain[i],fixed = TRUE)[[1]] != -1)
    # check if unbalanced operators
    .balanced <-
      all(c(.f("{"),.f("("),.f("[")) == c(.f("}"),.f(")"),.f("]"))) &
      !.f("'") %% 2 &
      !.f('"') %% 2

    if (!.balanced) {
      # if unbalanced, combine with previous
      .pchain[[i - 1]] <- paste(.pchain[[i - 1]],"%>%", .pchain[[i]])
      .pchain[[i]] <- NULL
    }
  }

  .calls  <- Reduce(                             # build calls to display
    function(x,y) paste0(x," %>%\n  ",y),       
    .pchain, accumulate = TRUE)     

  .xinit  <- eval(parse(text = .pchain[1]))      
  .values <- Reduce(function(x,y){               # compute all values
    if (inherits(x,"try-error")) NULL
    else try(eval(parse(text = paste("x %>%", y))),silent = TRUE)},
    .pchain[-1], .xinit, accumulate = TRUE)

  message("press enter to show, 's' to skip, 'q' to quit, lhs can be accessed with `.`")
  for (.i in (seq_along(.pchain))) {
    cat("\n",.calls[.i])
    .rdl_ <- readline()
    . <- .values[[.i]]

    # while environment is explored
    while (!.rdl_ %in% c("q","s","")) {
      # if not an assignment, should be printed
      if (!grepl("^\\s*[[:alnum:]_.]*\\s*<-",.rdl_)) .rdl_ <- paste0("print(",.rdl_,")")
      # wrap into `try` to safely fail
      try(eval(parse(text = .rdl_)))
      .rdl_ <- readline()
    }
    if (.rdl_ == "q")  return(invisible(NULL))
    if (.rdl_ != "s") {
      if (inherits(.values[[.i]],"try-error")) {
        # a trick to be able to use stop without showing that
        # debug_pipe failed in the output
        opt <- options(show.error.messages = FALSE)
        on.exit(options(opt))
        message(.values[[.i]])
        stop()
      } else
      {
        print(.)
      }
    }
  }
  if (!is.na(.lhs)) assign(.lhs,tail(.values,1),envir = parent.frame())
  invisible(NULL)
}

Example code:

library(dplyr)

# copy following 4 lines to clipboard, no need to execute
test <- iris %>%
  slice(1:2) %>%
  select(1:3) %>%
  mutate(x=3)

debug_pipe()

# or wrap expression
debug_pipe(
test <- iris %>%
  slice(1:2) %>%
  select(1:3) %>%
  mutate(x=3)
)
like image 723
Moody_Mudskipper Avatar asked Jun 28 '18 16:06

Moody_Mudskipper


1 Answers

Here are the steps I came with :

Two good ressources were :

  • The reprex addin's code from Jenny Bryan
  • This RStudio webinar

1. create a new package

New Project/R package/Name package as pipedebug

2. build R file

Put the function's code into a .R file in the R folder. We rename the function pdbg as I realised that magrittr already has a function called debug_pipe that does something different (it executes browser and returns input).

We must add a second function, without parameter, that the addin will trigger, we can name it however we want:

pdbg_addin <- function(){
  selection <- rstudioapi::primary_selection(
    rstudioapi::getSourceEditorContext())[["text"]]
  rstudioapi::sendToConsole("",execute = F)
  eval(parse(text=paste0("pdbg(",selection,")")))
}

The first line captures the selection, adapted from reprex's code.

The second line is sending an empty string to the console and not executing it, that's all I found to move the cursor, but there might be a better way.

The third line is running the main function with the selection as an argument.

3. Create dcf file

Next step is to create file inst/rstudio/addins.dcf with following content:

Name: debug pipe
Description: debug pipes step by step
Binding: pdbg_addin
Interactive: false

usethis::use_addin("pdbg_addin") will create the file, fill it with a template and open it so you can edit it.

4. build package

Ctrl+Shift+B

5. Add shortcut

Tools / addins / browse addins / keyboard shortcuts / debug pipe / Ctrl+P

6. Test it

Copy in text editor / select / Ctrl+P

test <- iris %>%
  slice(1:2) %>%
  select(1:3) %>%
  mutate(x=3)

find a rough version here:

devtools::install_github("moodymudskipper/pipedebug")
?pdbg

similar efforts:

@Alistaire did this and advertised this other effort on his page.

like image 85
Moody_Mudskipper Avatar answered Oct 17 '22 20:10

Moody_Mudskipper