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

Есть ли способ кодировать возрастающие целые последовательности в 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"

Ответ 1

EDIT: добавлен элемент управления для векторов символов.

На основе 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

Ответ 2

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

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

EDIT: функция позаботиться о строках тоже

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

Ответ 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)))

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

Ответ 4

Как насчет:

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

Ответ 5

Здесь улучшается решение 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)])
}

Ответ 6

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

Обычно я делаю что-то подобное, когда я извлекаю данные из confirmit, 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)] сохранит его.