Применение гравитационной модели для оценки матрицы отключения в r - PullRequest
0 голосов
/ 02 декабря 2018

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

Эта модель говорит, что число поездок между отправлением i и назначением j определяется как:

T_ {i} = A_ {i} O_ {i} B_ {j} D_ {j} f (c_ {ij})

Где:

A_ {i} = \ left [\ sum_ {j} {B_ {j} D_ {j} f (c_ {ij})} \ right] ^ {- 1}

и

B_ {j} = \ left[\ sum_ {i} {A_ {i} O_ {i} f (c_ {ij})} \ right] ^ {- 1}

A_ {i} и B_ {j} являются параметрами, которые должныоценивать так, чтобы: \ sum_ {j} {T_ {ij}} = O_ {i} и \ sum_ {i} {T_ {ij}} = D_ {i}

Кроме того, в этом случае Iустановит:

f (c_ {ij}) = c ^ {- 0,9}

Это просто мера стоимости поездки («импеданс») между парами источник-пункт назначения.

Матрица отключения по этой модели может быть оценена с помощью процедуры итеративного двупропорционального подбора («поставки»), которая неявно вычисляет A_ {i} и B_ {j}.

Следующий код делает это для воображаемого набора итогов отправления и назначения и некоторых случайно выбранных данных о затратах (где стоимость должна быть строго положительной) для матрицы 5 на 5.

Основная идея состоит в том, чтобы сначала ограничить суммы строк матрицы, чтобы они равнялись заданным итоговым значениям исходной поездки, а затем ограничить суммы столбцов матрицы равными заданным суммарным значениям пункта назначения поездки.Это делается итеративно до тех пор, пока итоговые значения строк и столбцов не будут соответствовать удовлетворительному уровню точности.

# Setting origin (row) and destination (column) totals
TripOrig<-matrix(c(100,90,60,40,110))
TripDest<-matrix(c(60,110,50,100,80))

# Produce cost (impedance) matrix
CostMatrix<-matrix((rnorm(5*5,1,1.5))^2,5,5)

# Produce empty matrix for population with numbers of trips
TripInitial <- matrix(data=NA, nrow=5, ncol=5)

# Loop to populate initial trip matrix based on function

for(j in 1:5){
  for(i in 1:5){
    TripInitial[i,j] <-CostMatrix[i,j]^-0.9*TripOrig[i,1]*TripDest[j,1]
  }
}

# Set max iterations and the 'seed' trip matrix
MaxIter<-100
IterPrev<-TripInitial

# Bi-proportional fitting - iterate until convergence
for(i in 1:MaxIter) {

  EndIter<-i

  IterOrig<-matrix(data=NA, nrow=5, ncol=5)
  IterDest<-matrix(data=NA, nrow=5, ncol=5)

  for(j in 1:5){
    for(i in 1:5){
      IterOrig[i,j] = TripOrig[i,1]*IterPrev[i,j]/sum(IterPrev[i,])
    }
  }

  for(j in 1:5){
    for(i in 1:5){
      IterDest[i,j] = TripDest[j,1]*IterOrig[i,j]/sum(IterOrig[,j])
    }
  }

  RowTotals<-matrix(rowSums(IterDest))
  ColTotals<-matrix(colSums(IterDest))

  DiffOrig<-RowTotals-TripOrig
  DiffDest<-ColTotals-TripDest

  ConVal<-max(abs(DiffOrig),abs(DiffDest))

  IterPrev<-IterDest

  if (ConVal<.0001) {
    break
  }

}

Мой вопрос: могут ли эти необходимые матричные операции быть более эффективными при использовании семейства функций apply,как итерация по строкам и столбцам по отдельности не кажется вычислительно эффективной для больших матриц?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...