Блог

У меня есть ряд маркеров событий, которые входят в пары строк, например:

Пробный <- c(1, 2, 3, 4, 5, 6) Событие <- c(‘S 31’, ‘S 6’, ‘S 22’, ‘S 4’, ‘S 42’, ‘S 4’)

df <- data.frame(испытание, событие)

     Trial Event
    1     S 31
    2     S  6
    3     S 22
    4     S  4
    5     S 42
    6     S  4
  

Я хотел бы обновить событие с одной цифрой, объединив событие с двумя цифрами из предыдущей строки, чтобы оно выглядело так:

     Trial Event
    1     S 31
    2     S 316
    3     S 22
    4     S 224
    5     S 42
    6     S 424
  

Я изо всех сил пытаюсь придумать способ добиться этого и был бы признателен за любые советы.

Мы создаем столбец группировки для каждых 2 элементов, используя gl , затем replace последний элемент в «Событии», вводя paste проанализированное число из «События»

 library(dplyr)
library(stringr)
df %>%
   group_by(grp = as.integer(gl(n(), 2, n()))) %>%
   mutate(Event = replace(Event, n(), 
     str_c('S', str_c(readr::parse_number(Event), collapse=""),
       sep= ' '))) %>%
   ungroup %>%
   select(-grp)
  

-вывод

 # A tibble: 6 x 2
#  Trial Event
#  <dbl> <chr>
#1     1 S 31 
#2     2 S 316
#3     3 S 22 
#4     4 S 224
#5     5 S 42 
#6     6 S 424
  

Или другой вариант — вставить с lag помощью «События» при создании логического условия с case_when

 df %>% 
   mutate(Event = str_remove(case_when(row_number() %% 2 == 0 
         ~ str_c(lag(Event), Event), TRUE ~ Event), "(?<=[0-9])S\s "))
  

 df %>% 
   mutate(Event = str_remove(
        case_when(row_number() %% 2 == 0 ~ str_c(lag(Event), Event), 
        TRUE ~ Event), "(?<=[0-9])S\s "))
  

решение @akrun очень элегантно. Мой делает в основном то же самое, просто использует больше шагов, чтобы упростить выполнение.

 library(dplyr)
library(stringr)

# Exampe data
Trial <- c(1, 2, 3, 4, 5, 6)
Event <- c('S 31', 'S 6', 'S 22', 'S 4', 'S 42', 'S 4')
df <- data.frame(Trial, Event)
                 


df %>% 
  mutate(
    # extract number from chacater
    str_number = readr::parse_number(as.character(Event)),
    
    # new column with last rows value
    lag_col = ifelse(
      nchar(as.character(dplyr::lag(str_number))) > 1, 
      dplyr::lag(str_number),
      NA),
    
    # joins if has 2 characters
    Event = ifelse(
      is.na(lag_col),
      as.character(Event),
      paste0("S"," ",lag_col, str_number)
    )
  ) %>% 
  select(Trial, Event)