Отладка кода group_by / sumrize / do в R - PullRequest
Новая
       30

Отладка кода group_by / sumrize / do в R

0 голосов
/ 01 мая 2018

Я часто работаю с пакетом dplyr и функциями group_by / sumrize / do. У меня часто бывают большие наборы данных, и мне требуется 2 или 3 часа для вычисления моих функций (возможно, это можно оптимизировать, но это не тема).

Бывает, что после 1,5 часов вычислений моя функция do выдает ошибку, потому что я забыл учесть один конкретный случай в моем коде. Единственная проблема заключается в том, что я не знаю, какая итерация дает эту ошибку, и, как правило, мне приходится создавать циклы, чтобы заменить мой код group_by / Summaze / Do, чтобы узнать, какие данные вызывают проблему.

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

require(dplyr)

FUN <- function(x) {
  for (i in 1:which(!is.na(x$value))[1])
  {
    print("TEST")
  }
}

df <- data.frame(ID = c(rep("ID1",10), rep("ID2", 20), rep("ID3", 5)),
                 value= c(sample(1:100, 10), rep(NA, 20), sample(0:50, 5)))

Result <- group_by(df, ID) %>%
  do(Res=FUN(.))

Здесь у меня будет ошибка для второй группы (группа по ID2), потому что все значения равны NA, и цикл в FUN не может работать. Чтобы знать, что моя проблема связана с ID2, я бы сделал что-то вроде этого: 

for (j in 1:length(unique(df$ID)))
{
  Interm <- df[df$ID==unique(df$ID)[j],]
  Res <- FUN(Interm)
  print(j)
}

Благодаря этому я знаю, что моя проблема исходит от j = 2, то есть от ID2.

Это нормально для простых вычислений, подобных этому, но это действительно занимает много времени для моих функций. Например, правильно, мой код с group_by / do выдает ошибку через 45 минут, я сделал двухконтурный код, чтобы узнать, какие данные дают ошибку, и через 1,5 часа он все еще работает ... Когда я буду найти ошибку, я просто добавлю одну строку в свою функцию (FUN), чтобы учесть этот конкретный случай, перезапустить код do и, возможно, через 1 ч появится другая ошибка ...

Простой вопрос: есть ли способ узнать, из каких данных код выдает ошибку с кодом group_by / do?

Спасибо

Ответы [ 2 ]

0 голосов
/ 01 мая 2018

Ответ Фрэнка, безусловно, самый простой, но вот пример кода, над которым я работал для отладки в середине канала и тому подобное.

Предостережение emptor:

  • этот код проходит тестирование;
  • , даже если он хорошо испытан, нет намерения использовать его в производстве или в автоматическом режиме;
  • оно не было благословлено или даже рассмотрено никакими авторами или соавторами dplyr и связанных пакетов;
  • в настоящее время он работает в R-3.4 и dplyr-0.7.4, но он не использует многие «достоинства», которые следует использовать, такие как rlang и / или lazyeval;
  • это работает для моего использования, не проверено для вашего.

Сообщения об ошибках приветствуются, если / когда вы обнаружите что-то неладное.

Mid-pipe сообщение

Это может включать в себя все, что вы хотите: 

mtcars %>%
  group_by(cyl) %>%
  pipe_message(whichcyl = cyl[1], bestmpg = max(mpg)) %>%
  summarize(mpg=mean(mpg))
# Mid-pipe message (2018-05-01 09:39:26):
#  $ :List of 2
#   ..$ whichcyl: num 4
#   ..$ bestmpg : num 33.9
#  $ :List of 2
#   ..$ whichcyl: num 6
#   ..$ bestmpg : num 21.4
#  $ :List of 2
#   ..$ whichcyl: num 8
#   ..$ bestmpg : num 19.2
# # A tibble: 3 x 2
#     cyl   mpg
#   <dbl> <dbl>
# 1    4.  26.7
# 2    6.  19.7
# 3    8.  15.1

Mid-pipe assert

При желании вы можете просто понять, что происходит, и быстро посмотреть на данные, что позволит вам увидеть момент и затем выйти из канала: 

mtcars %>%
  group_by(cyl) %>%
  pipe_assert(all(mpg > 12), .debug=TRUE) %>%
  summarize(mpg = mean(mpg))
# #
# # all(mpg > 12) is not TRUE ... in Group: cyl:8
# # 'x' is the current data that failed the assertion.
# #
# Called from: pipe_assert(., all(mpg > 12), .debug = TRUE)
# Browse[1]> 
# debug at c:/Users/r2/Projects/StackOverflow/pipe_funcs.R#81: if (identical(x, .x[.indices[[.ind]], ])) {
#     stop(.msg, call. = FALSE)
# } else {
#     .x[.indices[[.ind]], ] <- x
#     return(.x)
# }
# Browse[2]> 
x
# # A tibble: 14 x 11
# # Groups:   cyl [1]
#      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#  1  18.7    8.  360.  175.  3.15  3.44  17.0    0.    0.    3.    2.
#  2  14.3    8.  360.  245.  3.21  3.57  15.8    0.    0.    3.    4.
#  3  16.4    8.  276.  180.  3.07  4.07  17.4    0.    0.    3.    3.
#  4  17.3    8.  276.  180.  3.07  3.73  17.6    0.    0.    3.    3.
#  5  15.2    8.  276.  180.  3.07  3.78  18.0    0.    0.    3.    3.
#  6  10.4    8.  472.  205.  2.93  5.25  18.0    0.    0.    3.    4.
#  7  10.4    8.  460.  215.  3.00  5.42  17.8    0.    0.    3.    4.
#  8  14.7    8.  440.  230.  3.23  5.34  17.4    0.    0.    3.    4.
#  9  15.5    8.  318.  150.  2.76  3.52  16.9    0.    0.    3.    2.
# 10  15.2    8.  304.  150.  3.15  3.44  17.3    0.    0.    3.    2.
# 11  13.3    8.  350.  245.  3.73  3.84  15.4    0.    0.    3.    4.
# 12  19.2    8.  400.  175.  3.08  3.84  17.0    0.    0.    3.    2.
# 13  15.8    8.  351.  264.  4.22  3.17  14.5    0.    1.    5.    4.
# 14  15.0    8.  301.  335.  3.54  3.57  14.6    0.    1.    5.    8.
# Browse[2]> 
c
# Error: all(mpg > 12) is not TRUE ... in Group: cyl:8

или вы можете по желанию обновить / изменить данные; Имейте в виду, что это изменяет данные в конвейере, а не в источнике, поэтому действительно хорош только в dev и / или одноразовых исправлениях: 

mtcars %>%
  group_by(cyl) %>%
  pipe_assert(all(mpg > 12), .debug=TRUE) %>%
  summarize(mpg = mean(mpg))
# #
# # all(mpg > 12) is not TRUE ... in Group: cyl:8
# # 'x' is the current data that failed the assertion.
# #
# Called from: pipe_assert(., all(mpg > 12), .debug = TRUE)
# Browse[1]> 
# debug at c:/Users/r2/Projects/StackOverflow/pipe_funcs.R#81: if (identical(x, .x[.indices[[.ind]], ])) {
#     stop(.msg, call. = FALSE)
# } else {
#     .x[.indices[[.ind]], ] <- x
#     return(.x)
# }

(Игнорировать текущую строку отлаженного кода, if ..., это мои вещи, и это не красиво.) Сейчас я нахожусь в отладчике, я могу посмотреть и изменить / исправить данные: 

# Browse[2]> 
x
# ...as before...
x$mpg <- x$mpg + 1000

Если данные изменены, канал продолжается, в противном случае он будет stop. 

# Browse[2]> 
c
# # A tibble: 3 x 2
#     cyl    mpg
#   <dbl>  <dbl>
# 1    4.   26.7
# 2    6.   19.7
# 3    8. 1015.

(Данные могут быть изменены, но метки не могут ... поэтому, если бы мы сделали x$cyl <- 99, он все равно показал бы 8 в остальной части канала. Это следствие того, что dplyr не позволил вам изменить группирующие переменные ... что хорошо, ИМО.)

Есть также pipe_debug, который всегда отлаживается, но он менее впечатляющий. Он также (в настоящее время) не передает измененные данные, поэтому для этого используйте pipe_assert (например, pipe_assert(FALSE,.debug=TRUE)).

Источник, также доступен в My Gist : 

#' Mid-pipe assertions
#'
#' Test assertions mid-pipe. Each assertion is executed individually
#' on each group (if present) of the piped data. Any failures indicate
#' the group that caused the fail, terminating on the first failure.
#'
#' If `.debug`, then the interpreter enters the `browser()`, allowing
#' you to look at the specific data, stored as `x` (just the grouped
#' data if `is.grouped_df(.x)`, all data otherwise). If the data is
#' changed, then the altered data will be sent forward in the pipeline
#' (assuming you fixed the failed assertion), otherwise the assertion
#' will fail (as an assertion should).
#'
#' @param .x data.frame, potentially grouped
#' @param ... unnamed expression(s), each must evaluate to a single
#'   'logical'; similar to [assertthat::assert_that()], rather than
#'   combining expressions with `&&`, separate them by commas so that
#'   better error messages can be generated.
#' @param .msg a custom error message to be printed if one of the
#'   conditions is false.
#' @param .debug logical, whether to invoke [browser()] if the
#'   assertion fails; if `TRUE`, then when the debugger begins on a
#'   fail, the grouped data will be in the variable `x`
#' @return data.frame (unchanged)
#' @export
#' @import assertthat
#' @md
#' @examples
#' \dontrun{
#'
#' library(dplyr)
#' library(assertthat)
#'
#' mtcars %>%
#'   group_by(cyl) %>%
#'   pipe_assert(
#'     all(cyl < 9),
#'     all(mpg > 10)
#'   ) %>%
#'   count()
#' # # A tibble: 3 x 2
#' #     cyl     n
#' #   <dbl> <int>
#' # 1     4    11
#' # 2     6     7
#' # 3     8    14
#' 
#' # note here that the "4" group is processed first and does not fail
#' mtcars %>%
#'   group_by(cyl, vs) %>%
#'   pipe_assert( all(cyl < 6) ) %>%
#'   count()
#' # Error: all(cyl < 6) is not TRUE ... in Group: cyl:6, vs:0
#'
#' }
pipe_assert <- function(.x, ..., .msg = NULL, .debug = FALSE) {
  if (is.grouped_df(.x)) {
    .indices <- lapply(attr(.x, "indices"), `+`, 1L)
    .labels <- attr(.x, "labels")
  } else {
    .indices <- list(seq_len(nrow(.x)))
  }
  for (assertion in eval(substitute(alist(...)))) {
    for (.ind in seq_along(.indices)) {
      .out <- assertthat::see_if(eval(assertion, .x[.indices[[.ind]],]))
      if (! .out) {
        x <- .x[.indices[[.ind]],]
        if (is.null(.msg)) .msg <- paste(deparse(assertion), "is not TRUE")
        if (is.grouped_df(.x)) {
          .msg <- paste(.msg,
                        paste("in Group:",
                              paste(sprintf("%s:%s", names(.labels),
                                            sapply(.labels, function(z) as.character(z[.ind]))),
                                    collapse = ", ")),
                        sep = " ... ")
        }
        if (.debug) {
          message("#\n", paste("#", .msg), "\n# 'x' is the current data that failed the assertion.\n#\n")
          browser()
        }
        if (identical(x, .x[.indices[[.ind]],])) {
          stop(.msg, call. = FALSE)
        } else {
          .x[.indices[[.ind]],] <- x
          return(.x)
        }
      }
    }
  }
  .x # "unmodified"
}

#' Mid-pipe debugging
#'
#' Mid-pipe peek at the data, named `x` within [browser()], but
#' *changes are not preserved*.
#'
#' @param .x data.frame, potentially grouped
#' @return data.frame (unchanged)
#' @export
#' @md
#' @examples
#' \dontrun{
#'
#' library(dplyr)
#'
#' mtcars %>%
#'   group_by(cyl, vs) %>%
#'   pipe_debug() %>%
#'   count()
#'
#' }
pipe_debug <- function(.x) {
  if (is.grouped_df(.x)) {
    .indices <- lapply(attr(.x, "indices"), `+`, 1L)
    .labels <- attr(.x, "labels")
  } else {
    .indices <- list(seq_len(nrow(.x)))
  }
  # I used 'lapply' here instead of a 'for' loop because
  # browser-stepping after 'browser()' in a 'for' loop could continue
  # through all of *this* code, not really meaningful; in pipe_assert
  # above, since the next call after 'browser()' is 'stop()', there's
  # little risk of stepping in or out of this not-meaningful code
  .ign <- lapply(seq_along(.indices), function(.ind, .x) {
    x <- .x[.indices[[.ind]],]
    message("#",
            if (is.grouped_df(.x)) {
              paste("\n# in Group:",
                    paste(sprintf("%s:%s", names(.labels),
                                  sapply(.labels, function(z) as.character(z[.ind]))),
                          collapse = ", "),
                    "\n")
            },
            "# 'x' is the current data (grouped, if appropriate).\n#\n")
    browser()
    NULL
  }, .x = .x)
  .x # "unmodified"
}

#' Mid-pipe status messaging.
#'
#' @param .x data.frame, potentially grouped
#' @param ... unnamed or named expression(s) whose outputs will be
#'   captured, aggregated with [utils::str()], and displayed as a
#'   [base::message()]; if present, a '.' literal is replace with a
#'   reference to the `data.frame` (in its entirety, not grouped)
#' @param .FUN function, typically [message()] or [warning()] (for
#'   when messages are suppressed); note: if set to `warning`, the
#'   argument `call.=FALSE` is appended to the arguments
#' @param .timestamp logical, if 'TRUE' then a POSIXct timestamp is
#'   appended to the header of the `str`-like output (default 'TRUE')
#' @param .stropts optional list of options to pass to [utils::str()],
#'   for example `list(max.level=1)`
#' @return data.frame (unchanged)
#' @export
#' @md
#' @examples
#' \dontrun{
#'
#' library(dplyr)
#'
#' mtcars %>%
#'   pipe_message(           # unnamed
#'     "starting",
#'     group_size(.)
#'   ) %>%
#'   group_by(cyl) %>%
#'   pipe_message(           # named
#'     msg  = "grouped",
#'     grps = group_size(.)
#'   ) %>%
#'   count() %>%
#'   ungroup() %>%
#'   pipe_message(           # alternate function, for emphasis!
#'     msg = "done",
#'     .FUN = warning
#'   )
#'
#' head(mtcars) %>%
#'   pipe_message(
#'     list(a = list(aa=1, bb=2, cc=3))
#'   )
#' head(mtcars) %>%
#'   pipe_message(
#'     list(a = list(aa=1, bb=2, cc=3)),
#'     .stropts = list(max.level = 2)
#'   )
#'
#' }
pipe_message <- function(.x, ..., .FUN = message, .timestamp = TRUE, .stropts = NULL) {
  .expressions <- eval(substitute(alist(...)))
  if (is.grouped_df(.x)) {
    .indices <- lapply(attr(.x, "indices"), `+`, 1L)
    .labels <- attr(.x, "labels")
  } else {
    .indices <- list(seq_len(nrow(.x)))
    .labels <- ""
  }
  lst <- mapply(function(.ind, .lbl) {
    .x <- .x[.ind,,drop=FALSE]
    lapply(.expressions, function(.expr) {
      if (is.call(.expr)) .expr <- as.call(lapply(.expr, function(a) if (a == ".") as.symbol(".x") else a))
      eval(.expr, .x)
    })
  }, .indices, .labels, SIMPLIFY=FALSE)
  .out <- capture.output(
    do.call("str", c(list(lst), .stropts))
  )
  .out[1] <- sprintf("Mid-pipe message%s:",
                     if (.timestamp) paste(" (", Sys.time(), ")", sep = ""))
  do.call(.FUN, c(list(paste(.out, collapse = "\n")),
                  if (identical(.FUN, warning)) list(call. = FALSE)))
  .x # "unmodified"
}
0 голосов
/ 01 мая 2018

Вы все еще можете печатать здесь: 

df %>% group_by(ID) %>% do({
  the_id = unique(.$ID)
  cat("Working on...", the_id, "which is...", match(the_id, unique(df$ID)), "/", n_distinct(df$ID), "\n")
  FUN(.)
})

который печатает 

Working on... 1 which is... 1 / 3 
[1] "TEST"
Working on... 2 which is... 2 / 3 
Error in 1:which(!is.na(x$value))[1] : NA/NaN argument

Я обычно делаю это (используя data.table не dplyr, но та же идея). Я понимаю, что есть более сложные способы отладки, но для меня это достаточно хорошо работает.

...