Кодирование длины последовательности с использованием R

Question

Есть ли способ кодирования увеличения целочисленных последовательностей в R, аналогично кодированию длин серий с использованием кодирования длин серий (rle)?

Я проиллюстрирую на примере:

Аналогия: кодирование длин серий

r <- c(rep(1, 4), 2, 3, 4, rep(5, 5))
rle(r)
Run Length Encoding
  lengths: int [1:5] 4 1 1 1 5
  values : num [1:5] 1 2 3 4 5

Желаемый: кодировка длины последовательности

s <- c(1:4, rep(5, 4), 6:9)
s
[1] 1 2 3 4 5 5 5 5 6 7 8 9

somefunction(s)
Sequence lengths
  lengths: int [1:4] 5 1 1 5
  value1 : num [1:4] 1 5 5 5

Редактировать 1

Таким образом, somefunction(1:10) даст результат:

Sequence lengths
  lengths: int [1:1] 10
  value1 : num [1:1] 1 

Этот результат означает, что существует целочисленная последовательность длиной 10 с начальным значением 1, т.е. seq(1, 10)

Обратите внимание, что в моем примере результата нет ошибки. Вектор фактически заканчивается в последовательности 5: 9, а не 6: 9, которая использовалась для его построения.

Мой пример использования: я работаю с данными опроса в файле экспорта SPSS. Каждый подзапрос в сетке вопросов будет иметь название шаблона paste("q", 1:5), но иногда есть «другая» категория, которая будет помечена q_99, q_other или что-то еще. Я хочу найти способ идентификации последовательностей.

Редактировать 2

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

lengths <- c(5, 1, 1, 5)
value1 <- c(1, 5, 5, 5)

s
[1] 1 2 3 4 5 5 5 5 6 7 8 9
sequence(lengths) + rep(value1-1, lengths) 
[1] 1 2 3 4 5 5 5 5 6 7 8 9

Редактировать 3

Я должен был заявить, что для моих целей последовательность определяется как возрастающая целочисленная последовательность , а не монотонно возрастающая последовательность, например c(4,5,6,7) но не c(2,4,6,8) и c(5,4,3,2,1). Однако любое другое целое число может появляться между последовательностями.

Это означает, что решение должно быть в состоянии справиться с этим контрольным примером:

somefunction(c(2, 4, 1:4, 5, 5))
    Sequence lengths
      lengths: int [1:4] 1 1 5 1
      value1 : num [1:4] 2 4 1 5 

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

somefunction(c(2, 4, 1:4, 5, "other"))
    Sequence lengths
      lengths: int [1:5] 1 1 5 1 1
      value1 : num [1:5] 2 4 1 5 "other"

Answer 1

РЕДАКТИРОВАТЬ: добавлен контроль для создания векторов символов.

На основе rle, я пришел к следующему решению:

somefunction <- function(x){

    if(!is.numeric(x)) x <- as.numeric(x)
    n <- length(x)
    y <- x[-1L] != x[-n] + 1L
    i <- c(which(y|is.na(y)),n)

    list(
      lengths = diff(c(0L,i)),
      values = x[head(c(0L,i)+1L,-1L)]
    )

}

> s <- c(2,4,1:4, rep(5, 4), 6:9,4,4,4)

    > somefunction(s)
    $lengths
    [1] 1 1 5 1 1 5 1 1 1

    $values
    [1] 2 4 1 5 5 5 4 4 4

Это работает на каждом тестовом примере, который я пробовал ииспользует векторизованные значения без предложений ifelse.Должен бежать быстрее.Он преобразует строки в NA, поэтому вы сохраняете числовой вывод.

> S <- c(4,2,1:5,5, "other" , "other",4:6,2)

> somefunction(S)
$lengths
[1] 1 1 5 1 1 1 3 1

$values
[1]  4  2  1  5 NA NA  4  2

Warning message:
In somefunction(S) : NAs introduced by coercion

Answer 2

Вот мое решение

diff_s = which(diff(s) != 1)
lengths = diff(c(0, diff_s, length(s)))
values  = s[c(1, diff_s + 1)]

РЕДАКТИРОВАТЬ: функция, чтобы заботиться о строках тоже

sle2 = function(s){
  s2 = as.numeric(s)
  s2[is.na(s2)] = 100 + as.numeric(factor(s[is.na(s2)]))
  diff_s2 = which(diff(s2) != 1)
  lengths = diff(c(0, diff_s2, length(s)))
  values  = s[c(1, diff_s2 + 1)]
  return(list(lengths = lengths, values = values))
}

sle2(c(4,2,1:5,5, "other" , "other",4:6,2, "someother", "someother"))

lengths
 [1] 1 1 5 1 1 1 3 1 1 1

$values
 [1] "4"   "2"  "1"   "5"  "other" "other"  "4"   "2"  "someother" "someother"

Warning message:
In sle2(c(4, 2, 1:5, 5, "other", "other", 4:6, 2, "someother", "someother")) :
  NAs introduced by coercion

Answer 3

Вы могли бы использовать это для начала (учитывая, что s выше):

s2<-c(0, diff(s))
s3<-ifelse((c(s2[-1], 0)==1) & (s2!=1), 1, s2)
rle(ifelse(s3==1, -1, seq_along(s3)))

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

Answer 4

Вот усовершенствование решения Joris Meys. Считайте, что это решение будущей проблемы :-).

Карл

seqle <- function(x,incr=1) {
    if(!is.numeric(x)) x <- as.numeric(x)
    n <- length(x)
    #y <- x[-1L] != x[-n] + 1L
    y <- x[-1L] != x[-n] + incr
    i <- c(which(y|is.na(y)),n)
    list( lengths = diff(c(0L,i)),  values = x[head(c(0L,i)+1L,-1L)])
}

Answer 5

Как насчет:

sle <- function(s)
{
    diffs <- which(diff(s)!=1)
    lengths <- c(diffs[1],diff(diffs),length(s)-diffs[length(diffs)])
    value1 <- s[c(1,diffs+1)]
    cat("", "Sequence Length Encoding\n", " lengths:")
    str(lengths)
    cat("  value1:")
    str(value1)
}


sle(s)
 Sequence Length Encoding
  lengths: int [1:4] 5 1 1 5
  value1: num [1:4] 1 5 5 5

sle(c(2,4,1:4,rep(5,4),6:9,4,4,4))
 Sequence Length Encoding
  lengths: int [1:9] 1 1 5 1 1 5 1 1 1
  value1: num [1:9] 2 4 1 5 5 5 4 4 4

Answer 6

«Мой пример использования: я работаю с данными опроса в файле экспорта SPSS. Каждый подзапрос в сетке вопросов будет иметь название вставки шаблона (« q », 1: 5), но иногда есть«другая» категория, которая будет отмечена как q_99, q_other или что-то еще. Я хочу найти способ идентификации последовательностей ».

Обычно я делаю что-то подобное, когда извлекаю данные из Подтвердить, DASH, SPSS, SAS, MySQL или чего-либо еще, в зависимости от источника, который всегда выводится в data.frame ():

surv.pull <- function(dat, pattern) {
  dat <- data.frame(dat[,grep(pattern,colnames(dat))],check.names=F)
return(dat)
}

Если вы используете pattern, как [q][_][9][9], вы можете решить вытянуть data.frame из других пространств данных, добавив или не добавив "."до конца [q][_][9][9]., так что он тянет q_99whatever

Большинство моих столбцов данных в такой форме, как это q8a.1, .3, .4, .5, .6, .7,.8, ... так что surv.pull(dat, "[q][8][a].") будет тянуть их всех, включая других, если есть указание.Очевидно, что с помощью регулярных выражений вы можете решить, стоит ли тянуть другого.

В качестве альтернативы, общее соглашение заключается в том, чтобы задавать другие заданные вопросы в конец пространства данных, так что быстрый df <- df[-ncol(df)] отбросит его или other_list <- df[ncol(df)] сохранит его.