резкое преобразование данных прогнозирования с использованием data.table в R

Ответ 1

Использование data.table в запросе OP.

Во-первых, просто data.table как создавать data.table решение data.table

т.е. разрушать то, что мы делаем, и только для этого первого прохода быть читаемым. NB После этого ниже (в кратком обновлении) я немного оптимизирую решение, потянув все вместе, например, путем объединения шагов, цепочки, назначения на месте и т.д. Более оптимизированное решение, как и следовало ожидать, будет гораздо менее читабельны, не понимая поэтапно представленного здесь сначала с целью показать людям, изучающим data.table, как они могут прийти к решению.

# First Pass = Step-by-step (not optimized) just first work out a solution 

library(data.table)

# Transform prediction data from 'orig' data.table into long format
# i.e. by melting pred#_bal and pred#_date columns
pred_data <- 
  data.table::melt( orig, 
                    measure = patterns("pred[0-9]+_bal", "pred[0-9]+_date"),  
                    value.name =     c("bals",           "date_prediction_run"))

pred_data[, type := "prediction"]  # add the 'type' column to pred_data (all are type="prediction")

# select desired columns in order
pred_data <- pred_data[, .( dates=date, bals, type, date_prediction_run, ID)] 


# Collect historical information from the most_recent_bal column, 
# which the OP wants for plotting purposes

graph_data <- 
  orig[ orig, 
        .(ID, dates=date, bals=most_recent_bal, date_prediction_run=x.date),
        on=.(ID, date>=date)]

graph_data[, type := "history"]  # these are all type="history" 

# final output, combining the prediction data and the graph data:
output <- rbindlist(list(pred_data, graph_data), use.names=TRUE)

ОБНОВЛЕНИЕ 3 = ВАЖНОЕ ПРИМЕЧАНИЕ: Код ниже не делает ничего, чтобы улучшить скорость!

Ниже приведен мой "Первый шаг при оптимизации путем объединения нескольких шагов и цепочки". Однако, хотя ниже я объединил некоторые шаги, использовал цепочку и выглядел красиво и коротко, код ниже не быстрее исходного пошагового решения выше, как я покажу в конце поста с эталонными таймингами. Я оставляю код ниже, поскольку он иллюстрирует хороший момент и предоставляет возможность обучения.

library(data.table)

# Transform prediction data into long format
# by melting pred#_bal and pred#_date columns
pred_data <- 
  data.table::melt( orig[, type := "prediction"],  #add the type column to orig, before melting 
                    measure = patterns("pred[0-9]+_bal", "pred[0-9]+_date"),  
                    value.name =     c("bals",           "date_prediction_run")
                  )[, .( dates=date, bals, type, date_prediction_run, ID)] # chain, to select desired columns in order


# FINAL RESULT:  rbindlist pred_data to historic data
pred_data <- 
  rbindlist( list( pred_data, orig[ orig[, type := "history"],  
                                    .(dates=date, bals=most_recent_bal, type, date_prediction_run=x.date, ID),
                                    on=.(ID, date>=date)]
                 ), 
             use.names=TRUE)

Продолжение UPDATE 3:

Тестирование таймингов с использованием очень удобного пакета microbenchmark:

Unit: milliseconds
                expr         min          lq        mean      median          uq         max neval
 h.l.m_first_attempt 1140.017957 1190.818176 1249.499493 1248.977454 1299.497679 1427.632140   100
h.l.m_second_attempt  231.380930  239.513223  254.702865  249.735005  262.516276  375.762675   100
  krads_step.by.step    2.855509    2.985509    3.289648    3.059481    3.269429    6.568006   100
     krads_optimized    2.909343    3.073837    3.555803    3.150584    3.554100   12.521439   100

Если посмотреть на результаты микрообнаружения, обратите внимание на то, как оба моих решения являются тем же самым средним временем. Поначалу это может не иметь смысла: почему мое "пошаговое" решение с гораздо большим количеством строк кода эффективно так же быстро, как и мое "оптимизированное" решение?

Ответ. Если вы посмотрите внимательно, все те же шаги появляются в обоих моих решениях. В моем "оптимизированном" решении, да, мы цепляемся, и вы можете сначала подумать о том, чтобы делать меньше заданий, чем "шаг за шагом" буквально излагает. Но, поскольку результаты тестов должны сказать вам, мы НЕ сделали меньше заданий! Т.е. в каждой точке, где мы используем [] для "объединения" другой операции, это буквально эквивалентно присвоению вашему первоначальному DT с помощью <-.

Если вы можете обернуть свою голову вокруг, вы будете на пути к лучшему программированию: вы можете с уверенностью пропустить шаг "цепочки" и вместо этого использовать <- чтобы указать шаг за шагом (более читаемый, более простой для отладки и более поддерживаемое) решение!

Там, где вы можете сэкономить время, дело доходит до того, что места не будут назначаться многократно без необходимости в цикле или применять операцию. Но это тема для другого сообщения, я думаю!

NB Если вы хотите использовать microbenchmark в своем собственном коде, все, что я сделал, это:

library(microbenchmark)
mbm <- microbenchmark(
  h.l.m_first_attempt = {
    # Pasted in h.l.m first solution, here
  },

  h.l.m_second_attempt = {
    # Pasted in h.l.m second solution, here
  },

  krads_step.by.step = {
    # Pasted in my first solution, here
  },

  krads_optimized = {
    # Pasted in my second solution, here
  },
  times = 100L
)
mbm

Если вам нужен график, выполните следующие действия:

library(ggplot2)
autoplot(mbm)

Ответ 2

Я попробовал это с помощью dplyr и reshape2 для этого, и я чувствую, что он немного более изящный (не apply что технически для циклов). Он также сокращает примерно 0,04 секунды времени выполнения.

t0 = Sys.time()

# Extract predicted values in long form
trial_bal = reshape2::melt(orig, id.vars = c("ID", "date"), measure.vars = 
c(colnames(orig)[grep("pred[0-9]{1,}_bal", colnames(orig))]))
colnames(trial_bal) = c("ID", "date_prediction_run", "type", "balance")
trial_bal$type = gsub("_bal", "", trial_bal$type)

trial_date = reshape2::melt(orig, id.vars = c("ID", "date"), measure.vars = 
c(colnames(orig)[grep("pred[0-9]{1,}_date", colnames(orig))]))
colnames(trial_date) = c("ID", "date_prediction_run", "type", "dates")
trial_date$type = gsub("_date", "", trial_date$type)

trial = merge.data.frame(trial_date, trial_bal, by = c("ID", "date_prediction_run", "type"))
trial$type = "prediction"
trial = trial %>% select(dates, balance, type, date_prediction_run, ID)

# Extract historical values in long form
temp = orig[, c("ID", "date", "most_recent_bal")]
temp = merge(temp[, c("ID", "date")], temp, by = "ID", allow.cartesian = TRUE)
temp = temp[temp$date.x >= temp$date.y, ]
temp$type = "history"
temp = temp %>% select(dates = date.y, balance = most_recent_bal, type, 
date_prediction_run = date.x, ID)

# Combine prediction and history
trial = rbind(trial, temp)
trial = trial %>% arrange(ID, date_prediction_run, desc(type), dates)

t1 = Sys.time()
t1 - t0 #Time difference of 0.1900001 secs

Это имеет 182 строки меньше, чем количество строк, которые у вас есть, потому что у вас есть dates = date_prediction_run два раза - один под prediction type и один в history.