Подтвердить что ты не робот

Функция для суммирования вектора чисел как строки?

Скажем, у меня есть следующий вектор чисел:

vec = c(1, 2, 3, 5, 7, 8, 9, 10, 11, 12)

Я ищу функцию, которая создаст строку, суммирующую список чисел так, как это сделал бы человек, т.е.

"1-3, 5, 7-12"

Как это сделать в R?

4b9b3361

Ответ 1

Добавив еще одну альтернативу, вы можете использовать подход deparse ing. Например:

deparse(c(1L, 2L, 3L))
#[1] "1:3"

Воспользовавшись as.character "отменив" вводный "список" в качестве входных данных, мы могли бы использовать:

as.character(split(as.integer(vec), cumsum(c(TRUE, diff(vec) != 1))))
#[1] "1:3"  "5"    "7:12"
toString(gsub(":", "-", .Last.value))
#[1] "1-3, 5, 7-12"

Ответ 2

Я предполагаю, что вектор отсортирован, как в примере. Если не использовать vec <- sort(vec) заранее.

Отредактируйте примечание: @DavidArenburg обнаружил ошибку в моем первоначальном ответе, где c(min(x), x) должно быть c(0, x). Так как теперь мы знаем, что нам всегда нужно добавить 0, мы можем опустить первый шаг создания x и сделать это "на лету". Исходный ответ и дополнительные параметры теперь редактируются, чтобы отразить это (вы можете проверить историю изменений для исходного сообщения). Спасибо Дэвиду!

Заметка о вызовах unname: я использовал unname(sapply(...)), чтобы гарантировать, что результирующий вектор не назван, иначе он будет иметь имя 0: (n-1), где n равно длине new_vec. Как замечает @Tensibai в комментариях, это не имеет значения, если конечная цель состоит в генерации вектора символа длины-1, созданного при запуске toString(new_vec), так как в любом случае имена векторов будут опущены на toString.


Один вариант (возможно, не самый короткий):

new_vec <- unname(sapply(split(vec, c(0, cumsum(diff(vec) > 1))), function(y) {
  if(length(y) == 1) y else paste0(head(y, 1), "-", tail(y, 1))
}))

Результат:

new_vec
#[1] "1-3"  "5"    "7-12"
toString(new_vec)
#[1] "1-3, 5, 7-12"

Благодаря @Zelazny7 его можно сократить с помощью функции range:

new_vec <- unname(sapply(split(vec, c(0, cumsum(diff(vec) > 1))), function(y) {
    paste(unique(range(y)), collapse='-')
}))

Благодаря @DavidArenburg его можно сократить, используя tapply вместо sapply + split:

new_vec <- unname(tapply(vec, c(0, cumsum(diff(vec) > 1)), function(y) {
  paste(unique(range(y)), collapse = "-")
}))

Ответ 3

EDITS: я ускорил код доцендо совсем немного, сначала отсортировав вектор, так что теперь они фактически находятся на равных.

Я также добавил подход alexis.

readable_integers <- function(integers)
{
  integers <- sort(unique(integers))
  group <- cumsum(c(0, diff(integers)) != 1)

  paste0(vapply(split(integers, group),
           function(x){
             if (length(x) == 1) as.character(x)
             else paste0(range(x), collapse = "-")
           },
           character(1)),
           collapse = "; ")
}

library(microbenchmark)
vec = c(1, 2, 3, 5, 7, 8, 9, 10, 11, 12)
microbenchmark(
  docendo = {vec <- sort(vec)
    x <- cumsum(diff(vec) > 1)
   toString(tapply(vec, c(min(x), x), function(y) paste(unique(range(y)), )collapse = "-"))
  },
  Benjamin = readable_integers(vec),
  alexis = {vec <- sort(vec)
            as.character(split(as.integer(vec), cumsum(c(TRUE, diff(vec) != 1))))
            toString(gsub(":", "-", .Last.value))}
)

Unit: microseconds
     expr     min       lq     mean  median       uq     max neval
  docendo 205.273 220.3755 230.3134 228.293 235.4780 467.142   100
 Benjamin 121.991 128.4420 135.5302 133.574 143.3980 161.286   100
   alexis 121.698 128.0030 137.0374 136.507 143.3975 169.790   100

set.seed(pi)
vec = sample(1:1000, 900)

set.seed(pi)
vec = sample(1:1000, 900)

microbenchmark(
  docendo = {vec <- sort(vec)
   x <- cumsum(diff(vec) > 1)
   toString(tapply(sort(vec), c(min(x), x), function(y) paste(unique(range(y)), collapse = "-")))
  },
  Benjamin = readable_integers(vec),
  alexis = {vec <- sort(vec)
            as.character(split(as.integer(vec), cumsum(c(TRUE, diff(vec) != 1))))
            toString(gsub(":", "-", .Last.value))}
)
Unit: microseconds
     expr      min        lq      mean    median        uq      max neval
  docendo 1307.294 1353.7735 1420.3088 1379.7265 1427.8190 2554.473   100
 Benjamin  615.525  626.8155  661.2513  638.8385  665.3765 1676.493   100
   alexis  799.684  808.3355  866.1516  820.0650  833.2615 1974.138   100