Расчет прокатки в R с условием

Question

У меня есть таблица данных, такая как:

 CurrOdo        Lat            NextLat       PrevODO        NextOdo
 2.62           30.01115868   30.01115868           
 5.19           30.01116407   30.01116407       
 7.61           30.01116919   30.01116919       
18.82                         30.01119282     7.61        19.06
19.06           30.01119282   30.01119282       
19.35           30.01119339   30.01119339       
20.54                         30.01122998     19.35       81.5
20.81                         30.01122998     20.54       81.5
37.38                         30.01122998     20.81       81.5
81.5            30.01132238   30.01132238   

atable<-data.table(odo = c(2.62,5.19,7.61,18.82,19.06,19.35,20.54,20.81, 37.38,81.5 ), 
Lat = c(30.01115868,30.01116407,30.01116919,NA,30.01119282,30.01119339,NA,NA, NA, 30.01132238),
NextLat=c(30.01115868,30.01116407,30.01116919, 30.01119282, 30.01119282,30.01119339, 
30.01122998,30.01122998,30.01122998,30.01122998 ),
PrevLat=c(NA,NA,NA, NA, NA,NA, NA,NA,NA,NA ),
PrevODO=c(NA,NA,NA, 7.61, NA,NA, 19.35,20.54,20.81,NA ),
NextOdo=c(NA,NA,NA, 19.06, NA,NA, 81.5,81.5,81.5,NA )) 

Значение Lat представляет собой скользящий расчет на основе этой формулы:

Lat: (NextLat- PrevLat) * ((CurrODO -PrevODO) / (NextODO - PrevODO)) + PrevLat

Примеры того, как будет вычисляться Lat

Row CurrODO 18.82:   (30.01119282- 30.01116919) * (( 18.82 - 7.61) / (19.06 - 7.61)) + 30.01116919
Row CurrODO 20.54:  (30.01122998- 30.01119339) * ((  20.54 - 19.35) / (81.5 - 19.35)) + 30.01119339
Row CurrODO 20.81:   (30.01122998- Lat calc result from 20.54 row) * ((20.81 - 20.54) / (81.5 - 20.54)) + Lat calc result from 20.54 row
Row CurrODO 37.38:   (30.01122998- Lat calc result from 20.81 row) * (( 37.38 - 20.81) / (81.5 - 20.81)) + Lat calc result from 20.81 row

, конечный результат будет:

CurrOdo     Lat             NextLat         PrevODO     NextOdo
2.62        30.01115868     30.01115868             
5.19        30.01116407     30.01116407             
7.61        30.01116919     30.01116919             
18.82       30.0111923247   30.01119282      7.61        19.06  
19.06       30.01119282     30.01119282             
19.35       30.01119339     30.01119339             
20.54       30.0111940906   30.01122998      19.35       81.5   
20.81       30.0111942496   30.01122998      20.54       81.5   
37.38       30.0112040049   30.01122998      20.81       81.5   
81.5        30.01132238     30.01132238             

Яв настоящее время выполняется это на SQL-сервере в цикле, но это занимает очень много времени. Я также могу поместить его в цикл с R, но он не будет хорошо работать с большими наборами данных. Я застрял на этом в течение нескольких дней, поэтому любая помощь приветствуется!

Answer 1

Мой ответ включает в себя повторную петлю, хотя вы сказали "нет петель" , но я не вижу другого пути (может быть, конечно, это R ;-)).
Цикл должен работать довольно быстро, хотя в моей системе заполнение NA в 10M строках занимает около секунды (см. Тесты).

Вывод для Lat соответствует желаемому выводу в вопросе.

sidenote:
Вы можете столкнуться с проблемами, если ваш первый Lat имеет значение NA.
с тех пор PrevLat всегда будет NA в первом ряду, NA первого ряда для Lat никогда не будет пересчитан, и цикл никогда не прервется.
Вы можете (конечно) построить маршрут эвакуации / разрыв впетля, которая предотвращает это. Я сохранил это, чтобы сделать пример читабельным и коротким.

repeat{
  #until there are no more NA in Lat
  if( sum( is.na( atable$Lat ) ) == 0 ){
    break
  }
  #(re)calculate PrevLat
  atable[, PrevLat := shift( Lat, 1, type = "lag" ) ]
  #calculate Lat when PrevLat is known, but Lat is not
  atable[ is.na( Lat ) & !is.na( PrevLat ),
          Lat := (NextLat-PrevLat)*((odo-PrevODO)/(NextOdo-PrevODO))+PrevLat ]
}

#       odo           Lat     NextLat       PrevLat PrevODO NextOdo
# 1:   2.62 30.0111586800 30.01115868            NA      NA      NA
# 2:   5.19 30.0111640700 30.01116407 30.0111586800      NA      NA
# 3:   7.61 30.0111691900 30.01116919 30.0111640700      NA      NA
# 4:  18.82 30.0111923247 30.01119282 30.0111691900    7.61   19.06
# 5:  19.06 30.0111928200 30.01119282 30.0111923247      NA      NA
# 6:  19.35 30.0111933900 30.01119339 30.0111928200      NA      NA
# 7:  20.54 30.0111940906 30.01122998 30.0111933900   19.35   81.50
# 8:  20.81 30.0111942496 30.01122998 30.0111940906   20.54   81.50
# 9:  37.38 30.0112040049 30.01122998 30.0111942496   20.81   81.50
# 10: 81.50 30.0113223800 30.01122998            NA      NA      NA

Тесты

В таблице данных из 10 миллионов строк (ваш atable повторенный 1Mраз);
В моей системе (+/- 6-летний i5 с памятью 16 Гб) цикл занимает около секунды для вычисления значения для каждого лата.

dt <- atable[rep(atable[, .I], 1000000)]

system.time(
  repeat{
    #until there are no more NA in Lat
    if( sum( is.na( dt$Lat ) ) == 0 ){
      break
    }
    #(re)calculate PrevLat
    dt[, PrevLat := shift( Lat, 1, type = "lag" ) ]
    #calculate Lat when PrevLat is known
    dt[ is.na( Lat ) & !is.na( PrevLat ),
            Lat := (NextLat- PrevLat ) * ((odo - PrevODO) / (NextOdo - PrevODO)) + PrevLat ]
  }
)

# user  system elapsed 
# 0.90    0.35    1.08

sessioninfo

R version 3.6.1 (2019-07-05)   
Platform: x86_64-w64-mingw32/x64 (64-bit)    
Running under: Windows 10 x64 (build 18362)      

other attached packages:    [1] data.table_1.12.4

обновление :: объяснение кода

Что делает код:

1. заполняет столбец PrevlatLat -значение из предыдущей строки
2. идентифицирует все строки, где Lat равно NA и , где PrevLat имеет значение (то есть не NA)
3. для всех строк, определенных на шаг 2. , рассчитайте значение для Lat на основе предоставленной вами функции

повторяйте шаги с 1 по 3, пока сумма проверки is.na(atable$Lat) не станет равна 0. Когда это условие выполнено, в столбце Lat больше не будет NA -значений, поэтому мы можемвыйдите из repeat -loop используя break.

Answer 2

Я буду рад, если меня исправит R-гуру, но я на самом деле не видел простых способов накапливать значения вперед без зацикливания, как у вас.

Но я полагаю, что если вы установите Rcpp и любую связанную атрибутику, вы можете сделать что-то вроде этого:

src <-
  "NumericVector fill_lat_na(NumericMatrix v){
    NumericVector ret(v.nrow());
    for(int i=0; i < v.nrow(); ++i){
      ret[i] = v(i, 1);
      if(NumericVector::is_na(ret[i])) 
      {
        ret[i] = (v(i, 2) - ret[i-1]) * ((v(i, 0) - v(i, 4)) / (v(i, 5) - v(i, 4))) + ret[i-1] ;
      }
    }
    return(ret);
  }
  "
Rcpp::cppFunction(src)

Это даст вам функцию fill_lat_na(), которую вы затем сможете вызывать в Rfashion:

lat <- fill_lat_na(as.matrix(dfmat))

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

Answer 3

Вот очень явный цикл в data.table в {}:

library(data.table)
atable<-data.table(odo = c(2.62,5.19,7.61,18.82,19.06,19.35,20.54,20.81, 37.38,81.5 ), 
                   Lat = c(30.01115868,30.01116407,30.01116919,NA,30.01119282,30.01119339,NA,NA, NA, 30.01132238),
                   NextLat=c(30.01115868,30.01116407,30.01116919, 30.01119282, 30.01119282,30.01119339, 
                             30.01122998,30.01122998,30.01122998,30.01122998 ),
                   PrevLat=c(NA,NA,NA, NA, NA,NA, NA,NA,NA,NA ),
                   PrevODO=c(NA,NA,NA, 7.61, NA,NA, 19.35,20.54,20.81,NA ),
                   NextOdo=c(NA,NA,NA, 19.06, NA,NA, 81.5,81.5,81.5,NA )) 

options('digits' = 10)

atable[, c('na_rleid', 'LagLat') := .(rleid(is.na(PrevODO)), shift(NextLat))]

atable[!is.na(PrevODO),
       Lat := {x = vector('numeric', .N)
       const = ((odo - PrevODO) / (NextOdo - PrevODO))

       x[1] = (NextLat[1] - LagLat[1]) * const[1] + LagLat[1]

         for (i in seq_len(.N)[-1]){
           x[i] = (NextLat[i] - x[i-1]) * const[i] + x[i-1]
         }
         x
       },
       by = na_rleid
       ]