Создание надстройки RStudio для отладки цепочек труб - PullRequest
0 голосов
/ 28 июня 2018

Я написал функцию, которая помогает пошагово выполнять цепочки труб.

Чтобы использовать его, пользователь должен скопировать инструкцию в буфер обмена, затем выполнить функцию и перейти к консоли, чтобы продолжить.

Я хотел бы создать надстройку, которая позволила бы мне выбирать инструкции и запускать функцию с Ctrl + P без неловких шагов.

В идеале, дополнение будет:

  1. захватить выделение
  2. запустить функцию
  3. переместить курсор на консоль
  4. быть вызвано Ctrl + P

Я полагаю, что это очень похоже на то, что делает надстройка contex, но я не знаю, с чего начать, поскольку я на 100% новичок в надстройках.

Я посмотрел на rstudioapi::getActiveDocumentContext(), но там не было ничего интересного для меня.

Как я могу сделать эту работу?

Функция

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)
}

Пример кода:

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)
)

1 Ответ

0 голосов
/ 02 июля 2018

Вот шаги, с которыми я пришел:

Два хороших ресурса были:

1. создать новый пакет

Новый пакет Project / R / Имя пакета как pipedebug

2. файл build R

Поместите код функции в файл .R в папке R. Мы переименовали функцию pdbg, так как я понял, что magrittr уже имеет функцию с именем debug_pipe, которая делает что-то другое (она выполняет браузер и возвращает ввод).

Мы должны добавить вторую функцию без параметров, которую сработает надстройка, мы можем назвать ее так, как хотим:

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

Первая строка захватывает выборку, адаптированную из кода reprex.

Вторая строка отправляет пустую строку на консоль и не выполняет ее, это все, что я нашел для перемещения курсора, но, возможно, есть и лучший способ.

Третья строка запускает основную функцию с выбором в качестве аргумента. Я использовал eval(parse(text(, потому что я не понимаю, как это сделать иначе, но я полагаю, что это зло.

3. Создать файл dcf

Следующим шагом является создание файла inst/rstudio/addins.df со следующим содержимым:

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

4. пакет сборки

* ** 1048 тысяча сорок семь * Ctrl + Shift + B

5. Добавить ярлык

Инструменты / надстройки / просмотр надстроек / сочетания клавиш / отладочная труба / Ctrl + P

6. Проверьте это

Скопировать в текстовом редакторе / выбрать / Ctrl + P

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

найти черновую версию здесь :

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

аналогичные усилия:

@ Алистер сделал это и объявил об этой другой попытке на своей странице.

...