How to address the value in the next row

Refresh

December 2018

Views

324 time

4

I have a data set of equity returns for some thousand companies for the past 30 years. Some of these companies are "DEAD" (usually delisted or bankrupt), and therefore they have returns = 0. I want to assign NAs to the returns of these companies, but only after the time they actually "died". In order to do so, I have tried to use the following code:

if(Returns$r == 0 & stri_detect_fixed(Returns$Company, "DEAD"), na.rm = TRUE){
  Returns$r[Returns$r == 0 & stri_detect_fixed(Returns$Company, "DEAD")] <- NA
}

This works pretty well, but unfortunately there are on occasion return values equal to 0 for DEAD/delisted companies even before they "died", and these values I want to remain at 0.

Therefore, what I need is a command/if condition telling R that I only want to return NAs if the return in the next row is equal to 0 as well. Do you guys have any suggestions? I hope I made my problem clear, though I do know my explanation may be a bit confusing.

Reproducible example

Returns <- structure(list(Date = c("04.09.17", "05.09.17", "06.09.17", "01.09.17", 
"02.09.17", "03.09.17", "04.09.17", "05.09.17", "06.09.17", "04.09.17", 
"05.09.17", "06.09.17"), Company = c("ORKLA", "ORKLA", "ORKLA", 
"VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17", 
"VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17", 
"XNEWCO", "XNEWCO", "XNEWCO"), r = c(0.04, 0, -0.02, 0.01, 0, -0.03, 
0, 0, 0, 0.01, 0, 0)), .Names = c("Date", "Company", "r"), row.names = c(NA, 
-12L), class = "data.frame")

(Edited to cover the case where a "live" company has zero returns at the end of the time series)

My data frame Returns looks something like this:

Date       Company                r
04.09.17   ORKLA                  0.04
05.09.17   ORKLA                  0.00
06.09.17   ORKLA                  -0.02
01.09.17   VISMA DEAD 04.09.17    0.01
02.09.17   VISMA DEAD 04.09.17    0.00
03.09.17   VISMA DEAD 04.09.17    -0.03
04.09.17   VISMA DEAD 04.09.17    0.00
05.09.17   VISMA DEAD 04.09.17    0.00
06.09.17   VISMA DEAD 04.09.17    0.00 
04.09.17   XNEWCO                 0.01
05.09.17   XNEWCO                 0.00
06.09.17   XNEWCO                 0.00

I would want it to be like this:

Date       Company                r
04.09.17   ORKLA                  0.04
05.09.17   ORKLA                  0.00
06.09.17   ORKLA                  -0.02
01.09.17   VISMA DEAD 04.09.17    0.01
02.09.17   VISMA DEAD 04.09.17    0.00
03.09.17   VISMA DEAD 04.09.17    -0.03
04.09.17   VISMA DEAD 04.09.17    NA
05.09.17   VISMA DEAD 04.09.17    NA
06.09.17   VISMA DEAD 04.09.17    NA
04.09.17   XNEWCO                 0.01
05.09.17   XNEWCO                 0.00
06.09.17   XNEWCO                 0.00

My current code (as you'll see above) wouldn't work, as it would replace the return of 0.00 for VISMA 02.09.17 with NA. I need it to remain 0.00, as this is before VISMA "died"

3 answers

0

Это может быть сделано путем изменения данных на месте:

# Please use dput() or a reproducible way of sharing your data

mydat <-
read.table(text="Date       Company                r
           '04.09.17'   ORKLA                  0.04
           '05.09.17'   ORKLA                  0.00
           '06.09.17'   ORKLA                  -0.02
           '01.09.17'   VISMA    0.01
           '02.09.17'   VISMA    0.00
           '03.09.17'   VISMA    -0.03
           '04.09.17'   VISMA    0.00
           '05.09.17'   VISMA    0.00
           '06.09.17'   VISMA    0.00",header=T)

for(i in 1:nrow(mydat)){
  if(i==nrow(mydat) & mydat$r[i]==0) {mydat$r[i] <- NA
  } else if(!is.na(mydat$r[i]) & mydat$r[i]==0 & mydat$r[i+1]==0) mydat$r[i] <- NA
}
      Date Company     r
1 04.09.17   ORKLA  0.04
2 05.09.17   ORKLA  0.00
3 06.09.17   ORKLA -0.02
4 01.09.17   VISMA  0.01
5 02.09.17   VISMA  0.00
6 03.09.17   VISMA -0.03
7 04.09.17   VISMA    NA
8 05.09.17   VISMA    NA
9 06.09.17   VISMA    NA

Логика говорит, что это:

Если значение rне уже NA (которые мы должны проверить , потому что вы не можете сделать логическую оценку на NA) и значение 0 в настоящее время и в следующем ряду, то компания мертва, так что r= NA.

Если это последняя строка набора данных , и значение 0 , то я не могу смотреть в будущее, так что я буду считать , что он мертв. Изменение NAк 0отменить это предположение. Мы можем также добавить уровне компании логику , чтобы улучшить это, если нам нравится:

# Same result as above, but handles the last row better by considering company

tmp0 <- mydat[0,]
for(c in unique(mydat$Company)){
  tmp <- mydat[mydat$Company==c,]
  for(i in 1:nrow(tmp)){
    if(!is.na(tmp$r[i]) & tmp$r[i]==0 & tmp$r[i+1]==0){
      tmp$r[i:nrow(tmp)] <- NA
    } 
  }
  tmp0 <- rbind(tmp0, tmp) 

}
tmp0

Мне нравится логика 2 - й способ немного лучше, но и должны работать и должны хорошо работать до возможно 1M строк. Если вы хотите выйти за рамки , что мы можем только sapplyту же логику , вместо использования цикла, и / или использовать любое количество больших типов данных , такие как tibbleили data.table.

2

Edit: При подготовке бенчмарка, я заметил , что состояние не хватало , чтобы предотвратить замену нулевых значений в конце временного ряда также для компаний , которые живы. К сожалению, этот случай не охватывается исходных данных образцов , предоставленных OP (до редактирования) , поэтому он пошел нераскрытым. Я ниже поправками решений соответствующим образом .


По словам О. П. в У меня есть набор данных акций возвращаются на несколько тысяч компаний за последние 30 лет , то набор данных может содержать несколько миллионов строк (консервативная оценку: 250 рабочих дней в год * 2000 компаний * 5 лет среднего существования = 2,5 М строк))

Таким образом, нам нужно заменить несколько значений без копирования всего набора данных . data.tableпозволяет обновлять данные на месте .

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

С data.table, есть два варианта здесь:

Используя rleid()функцию

library(data.table)
# coerce to data.table
setDT(Returns)
# convert character dates
Returns[, Date := as.IDate(Date, "%d.%m.%y")][]
# make sure data is ordered
setorder(Returns, Company, Date)[]

Returns[, Company %like% "DEAD" & r == 0 & rleid(r == 0) == max(rleid(r == 0)), 
        by = Company]

Для каждой мертвой компании, последняя последовательность нулевых значений определенно:

                Company    V1
 1:               ORKLA FALSE
 2:               ORKLA FALSE
 3:               ORKLA FALSE
 4: VISMA DEAD 04.09.17 FALSE
 5: VISMA DEAD 04.09.17 FALSE
 6: VISMA DEAD 04.09.17 FALSE
 7: VISMA DEAD 04.09.17  TRUE
 8: VISMA DEAD 04.09.17  TRUE
 9: VISMA DEAD 04.09.17  TRUE
10:              XNEWCO FALSE
11:              XNEWCO FALSE
12:              XNEWCO FALSE

V1Колонка используется для подмножества и обновление DTна месте:

Returns[Returns[,  Company %like% "DEAD" & r == 0 & rleid(r == 0) == max(rleid(r == 0)), 
                by = Company]$V1, r := NA_real_][]
          Date             Company     r
 1: 2017-09-04               ORKLA  0.04
 2: 2017-09-05               ORKLA  0.00
 3: 2017-09-06               ORKLA -0.02
 4: 2017-09-01 VISMA DEAD 04.09.17  0.01
 5: 2017-09-02 VISMA DEAD 04.09.17  0.00
 6: 2017-09-03 VISMA DEAD 04.09.17 -0.03
 7: 2017-09-04 VISMA DEAD 04.09.17    NA
 8: 2017-09-05 VISMA DEAD 04.09.17    NA
 9: 2017-09-06 VISMA DEAD 04.09.17    NA
10: 2017-09-04              XNEWCO  0.01
11: 2017-09-05              XNEWCO  0.00
12: 2017-09-06              XNEWCO  0.00

Нахождение индекса последнего ненулевого значения

Returns[, {tmp <- last(which(r != 0)) 
           if (Company %like% "DEAD" & tmp < .N) .I[seq.int(tmp + 1L, .N)]}, by = Company]

Здесь позиция последнего ненулевого значения каждого временного ряда определена , который используется для построения индексов для остальных нулевых значений для мертвых компаний. .Iи .Nспециальные символы в data.tableсинтаксисе. Проверка if (Company %like% "DEAD" & tmp < .N)требуется в случае , если нет нулевых значений в конце временного ряда в мертвой компании.

               Company V1
1: VISMA DEAD 04.09.17  7
2: VISMA DEAD 04.09.17  8
3: VISMA DEAD 04.09.17  9

Как указано выше, V1используется для подмножества и обновление Returnsна месте:

Returns[Returns[, {tmp <- last(which(r != 0))
                   if (Company %like% "DEAD" & tmp < .N) .I[seq.int(tmp + 1L, .N)]}, 
                by = Company]$V1, r := NA_real_][]
          Date             Company     r
 1: 2017-09-04               ORKLA  0.04
 2: 2017-09-05               ORKLA  0.00
 3: 2017-09-06               ORKLA -0.02
 4: 2017-09-01 VISMA DEAD 04.09.17  0.01
 5: 2017-09-02 VISMA DEAD 04.09.17  0.00
 6: 2017-09-03 VISMA DEAD 04.09.17 -0.03
 7: 2017-09-04 VISMA DEAD 04.09.17    NA
 8: 2017-09-05 VISMA DEAD 04.09.17    NA
 9: 2017-09-06 VISMA DEAD 04.09.17    NA
10: 2017-09-04              XNEWCO  0.01
11: 2017-09-05              XNEWCO  0.00
12: 2017-09-06              XNEWCO  0.00

эталонный тест

Hack-R утверждал , что его решение должно хорошо работать до возможно 1M строк . Итак, я хотел бы проверить это утверждение с эталоном.

Создание контрольных данных

library(data.table)

# create benchmark data
n_days <- 100L
n_comp <- 100L
n_dead <- round(0.1 * n_comp) # 10 per cent of companies are dead
Date <- seq(from = as.IDate("2015-01-01"), length.out = n_days, by = "1 day")
# company "names" consist of 4 digits at least
Company <- sprintf("%04i", seq_len(n_comp)) 

# cross join to create all combinations
Returns <- CJ(Date = Date, Company = Company)

set.seed(1L) # reuired for reproducible result
Returns[, r := round(rnorm(.N)/10.0, 2L)][]

# dead companies
dead <- data.table(Company = sample(Company, n_dead),
                   dead.date = sample(Date, n_dead))
# modify Returns
Returns[dead, on = .(Company, Date >= dead.date), r := 0]
# modify compay names
Returns[dead, on = "Company", Company := paste(Company, "DEAD", dead.date)]

# IMPORTANT: set order
setorder(Returns, Company, Date)
# keep original version
R0 <- copy(Returns)

Контрольный код

microbenchmark::microbenchmark(
  copy = Returns <- copy(R0),
  hackr1 = {
    mydat <- setDF(copy(R0))
    for(i in 1:nrow(mydat)){
      if(i==nrow(mydat) & mydat$r[i]==0) {mydat$r[i] <- NA
      } else if(!is.na(mydat$r[i]) & mydat$r[i]==0 & mydat$r[i+1]==0) mydat$r[i] <- NA
    }
    res_hackr1 <- mydat
  },
  hackr2 = {
    mydat <- copy(R0)
    tmp0 <- mydat[0,]
    for(c in unique(mydat$Company)){
      tmp <- mydat[mydat$Company==c,]
      for(i in 1:nrow(tmp)){
        if(!is.na(tmp$r[i]) & tmp$r[i]==0 & tmp$r[i+1]==0){
          tmp$r[i:nrow(tmp)] <- NA
        }
      }
      tmp0 <- rbind(tmp0, tmp)
    }
    res_hackr2 <- tmp0
  },
  dt_rleid1 = {
    Returns <- copy(R0)
    Returns[Returns[,  Company %like% "DEAD" & r == 0 & rleid(r == 0) == max(rleid(r == 0)), 
                    by = Company]$V1, r := NA_real_]
    res_dt_rleid1 <- copy(Returns)
    },
  dt_rleid2 = {
    Returns <- copy(R0)
    Returns[Company %like% "DEAD" & Returns[,  r == 0 & rleid(r == 0) == max(rleid(r == 0)), 
                    by = Company]$V1, r := NA_real_]
    res_dt_rleid2 <- copy(Returns)
  },
  dt_last = {
    Returns <- copy(R0)
    Returns[Returns[, {
      tmp <- last(which(r != 0))
      if (Company %like% "DEAD") .I[tmp + seq_len(.N - tmp)]
    }, 
    by = Company]$V1, r := NA_real_]
    res_dt_last <- copy(Returns)
  },
  dt_last2 = {
    Returns <- copy(R0)
    Returns[Returns[, {
      tmp <- last(which(r != 0))
      if (Company %like% "DEAD" & tmp < .N) .I[seq.int(tmp + 1L, .N)]
    }, 
    by = Company]$V1, r := NA_real_]
    res_dt_last2 <- copy(Returns)
  },
  times = 11L
)

Поскольку коды изменить данные , установленные в месте , copy()используются для создания «свежие» неизмененных данных , установленных перед каждым запуском , а также для сохранения результата для последующего сравнения. Поэтому copy()приурочено также.

dt_rleid1и dt_rleid2так же , как dt_lastи dt_last2вариация коды соответствующих решений.

результаты тестирования

К сожалению, hackr2 остановил выполнение с сообщением об ошибке:

Ошибка в случае {(is.na (TMP $ г [I]) и TMP $ г [я] == 0 & TMP $ г [+ 1] == 0!):
Пропущенное значение , где значение TRUE / FALSE Необходимый

Тайминги для остальных решений являются:

Unit: microseconds
      expr        min         lq         mean     median          uq        max neval cld
      copy     46.065     48.331     53.75427     52.485     58.1475     66.077    11  a 
    hackr1 267515.143 269559.179 277240.15827 271093.857 275196.8435 329919.874    11   b
 dt_rleid1   2203.942   2404.060   3130.73218   2690.267   3728.9925   4813.783    11  a 
 dt_rleid2   2577.370   2665.346   5750.63073   2700.839   2741.0510  36395.429    11  a 
   dt_last   1605.098   1627.564   1718.85318   1654.561   1724.6030   2036.296    11  a 
  dt_last2   1665.134   1718.372   1945.67645   1764.438   1769.5350   3909.476    11  a

Эти data.tableрешения являются две величины быстрее , чем подход Hack-R для достаточно малого размера задачи 100 х 100 = 10 К строк. Я попытался запустить решение Hack-R 1000 х 1000 = 1 M строк , но у меня не было терпения ждать результата.

Для получения 1 М строк, подход нахождения последнего ненулевого значения составляет приблизительно от 5 до 6 раз быстрее rleid()подход.

Unit: milliseconds
      expr        min         lq      mean     median        uq      max neval cld
      copy   6.602008   6.843094  21.23383   7.297889  13.61614 141.5794    11 a  
 dt_rleid1  63.282609  70.239165 142.21568 193.972143 199.32077 224.5657    11  b 
 dt_rleid2 157.939571 281.185658 266.62148 288.184692 291.61445 309.5796    11   c
   dt_last  35.826792  39.198781 101.66298  48.387030 172.40187 182.2354    11  b 
  dt_last2  36.507194  43.754676 103.95414  48.879018 173.66035 183.1639    11  b
Uwe
0

Там может быть более простым решением, но я беру его шаг за шагом длинный путь без петли / функции.

library( data.table )
library( stringr )


# Create a dummy variable **status_delisting** to show if the company is dead. 
df$status_delisting = ifelse( grepl( "DEAD", df$Company ), 1, 0 )

# Find names with numbers in it, check if the numbers are dates and convert to format. Sometimes the company has numbers in the name. 
df$Company = as.character( df$Company )
check_values = c( unique( df$Company ) )
setDT(check_values)
names( check_values ) = "check_memo"

# You might need this as well. 
# Sys.getlocale()
# Sys.setlocale(locale="C")
# Check if there are dates in the name
# The date format we check is N.N.N at least. 
check_values$Date_Flag = ifelse( grepl("([0-9]+)(.)([0-9]+)([0-9]+)", 
check_values$check_memo), 1, 0 )
# Create new column with the proposed format of date
# dd . mm . yy
pat <- "[0-9][0-9][.][0-9][0-9][.][0-9][0-9]"
check_values[,Date_Flag := str_count( check_memo, pat ) == 1 ]
check_values[(Date_Flag),  paste0( "Date", 1 ) := transpose( str_extract_all( check_memo, pat ))]

Удалить компании, которые не исключены (без даты исключения из списка).

setDF( check_values )
check_values = filter( check_values, !is.na(Date1))

Слияние мертвых компаний с кадром данных

df = left_join( x = df, y = check_values, by = c("Company" = "check_memo"))

Формат обе даты как даты

df$Date = as.Date( df$Date, format = "%d.%m.%y")
df$Date1 = as.Date( df$Date1, format = "%d.%m.%y")

Создать новый столбец с возвратами по желанию. Вы можете удалить лишние столбцы.

 df$returns = ifelse(
  df$status_delisting == 1, 
 ifelse(df$Date <= df$Date1, df$r, NA), df$r )