Recuperar posição inicial e final de uma sequencia contínua

Boa tarde pessoal,

Estou com uma dúvida de como manusear um dataframe de forma que eu consiga recuperar a posição final e inicial de uma sequencia contínua de números (sem que haja gap entre eles).
O dataframe contem 3 colunas, uma com nome, outra com posição inicial e posição final da minha sequencia.

library(tibble)
sample <- tibble(name = "test", 
                 start = c(25,46,55,67,324,352,353,354,481), 
                 end = c(39,60,69,80,338,365,367,367,494))

sample
#> # A tibble: 9 × 3
#>   name  start   end
#>   <chr> <dbl> <dbl>
#> 1 test     25    39
#> 2 test     46    60
#> 3 test     55    69
#> 4 test     67    80
#> 5 test    324   338
#> 6 test    352   365
#> 7 test    353   367
#> 8 test    354   367
#> 9 test    481   494

Created on 2022-11-11 with reprex v2.0.2

Created on 2022-11-11 with reprex v2.0.2

Nesse caso eu queria recuperar 5 sequencias:
posição inicial posição final
25 39
46 80
324 338
352 367
481 494

Qual a melhor maneira de fazer isso?

Obrigada desde já!

O código não ficou muito bonito, mas foi o melhor que eu consegui sem aumentar muito a complexidade. A lógica é a seguinte:

  1. Criar uma coluna group que vai dizer quais linhas da tabela pertencem à mesma sequência. Ela começa com um número diferente em cada linha.
  2. Iterar em todas as linhas fazendo o seguinte:
    a. Ver quais linhas fazem parte da mesma sequência que a linha i
    b. Para todas as linhas que fizerem parte da mesma sequência de i, corrigir group
  3. Agrupar e sumarizar a tabela, determinando o início e o fim de todas as sequências apontadas por group
sample <- tibble::tibble(
  name = "test", 
  start = c(25,46,55,67,324,352,353,354,481),
  end = c(39,60,69,80,338,365,367,367,494)
)

# Cria coluna temporária
sample <- dplyr::mutate(sample, group = 1:dplyr::n())

# Verifica se há intersecção
overlap <- function(s1, e1, s2, e2) {
  e1 - s2 >= 0 && e2 - s1 >= 0
}

# Muda a coluna 'group' para juntar as intersecções
for (i in seq_along(sample$group)) {
  same <- purrr::map2_lgl(
    sample$start,
    sample$end,
    overlap,
    sample$start[i],
    sample$end[i]
  )
  sample$group[same] <- sample$group[i]
}

# Mostra o resultado
sample |>
  dplyr::group_by(name, group) |>
  dplyr::summarise(start = min(start), end = max(end)) |>
  dplyr::ungroup() |>
  dplyr::select(-group)
#> # A tibble: 5 × 3
#>   name  start   end
#>   <chr> <dbl> <dbl>
#> 1 test     25    39
#> 2 test     46    80
#> 3 test    324   338
#> 4 test    352   367
#> 5 test    481   494

Created on 2022-11-11 with reprex v2.0.2

Era isso mesmo que você queria, Laila? Me avisa se precisar que eu faça alguma correção!

P.S.: O algoritmo que eu usei é baseado na sobreposição de linhas colineares.

1 curtida

Oi Caio, muito obrigada! Era exatamente isso que tava precisando! Salvou demais :slight_smile:

1 curtida

Oi Caio, deixa eu te perguntar. No meu caso real, eu estou trabalhando com 1028581 linhas que pertencem a 1963 grupos diferentes. Deixei rodando a sua solução no servidor e até agora não finalizou. Minha dúvida é: ele realmente está rodando e vai demorar para acabar dado o tamanho do arquivo ou chega num ponto que ele não consegue seguir mais? Se no caso o problema é o segundo, qual seria a melhor maneira de contornar isso?

Laila, de fato o código não está muito otimizado e é bem plausível que esteja demorando dias mesmo :frowning: Eu fiz uma nova versão que deve ser em torno de 100x mais rápida que a anterior, veja se ajuda:

df <- tibble::tibble(
  name = "test", 
  start = c(25,46,55,67,324,352,353,354,481),
  end = c(39,60,69,80,338,365,367,367,494)
)

juntar <- function(grupos, seq) {
    
  for (i in seq_along(grupos)) {
    grupo <- grupos[[i]]
    
    if (seq$end >= grupo$start && seq$start <= grupo$end) {
      grupo$start <- min(seq$start, grupo$start)
      grupo$end <- max(seq$end, grupo$end)
      return(grupos)
    }
  }
  
  return(c(grupos, list(seq)))
}

df |>
  dplyr::select(start, end) |>
  purrr::transpose() |>
  purrr::reduce(juntar, .init = list()) |>
  purrr::transpose() |>
  purrr::map(purrr::flatten_dbl) |>
  tibble::as_tibble()
#> # A tibble: 6 × 2
#>   start   end
#>   <dbl> <dbl>
#> 1    25    39
#> 2    46    60
#> 3    67    80
#> 4   324   338
#> 5   352   365
#> 6   481   494

Created on 2022-11-14 with reprex v2.0.2

A grande desvantagem é que esse código não consegue lidar com colunas extras, então você precisará adaptá-lo conforme a sua necessidade. Outra sugestão é colocar algum print() dentro do loop pra você ter uma noção de quanto tempo já passou e quanto ainda resta na execução.

1 curtida

Oi @clente, obrigada! Com relação à outra coluna, não tem problema, eu itero com base nos nomes dos meus grupos… Só tem uma coisa, esse novo código está dando um resultado diferente do primeiro. E pelas minhas checagens o primeiro me retorna corretamente e esse novo parece não conseguir juntar onde deveria. No próprio exemplo que está aqui ele retorna diferentes números de linhas… :frowning:
O que pode ser?

Caramba, Laila :confused: Agora não consigo conferir, mas deve ter algum erro no algoritmo. Depois vejo o que está acontecendo.