Найти треугольники с более короткими ребрами в матрице расстояний - PullRequest
Новая
       33

Найти треугольники с более короткими ребрами в матрице расстояний

0 голосов
/ 28 сентября 2018

Я пытаюсь найти треугольники в матрице расстояний, где прямой путь длиннее, чем проход через другую точку.Цель состоит в том, чтобы уменьшить количество ребер в полностью связном графе.Функция работает хорошо при низких значениях n, но медленно при больших значениях.Я пытаюсь выяснить, как ускорить этот процесс.

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

Я пыталсяиспользуйте lineprof и нажимайте, чтобы понизить функции, но я не понимаю, что это говорит мне.Я не знаю, есть ли какая-нибудь функция в igraph, которая бы помогла? 

library(purrr);library(magrittr); library(lineprof);library(shiny)

#The function used to find triangles
RemoveTri <- function(s){
  Smat<- col(s) 
  RemoveEdge <- 1:ncol(s) %>%
  map(~{
  print(.x)
    LogicMat <- s + s[,.x][Smat] < (s[,.x]) #I used this method to avoid transposing
    matrix(data = rowSums(LogicMat, na.rm = TRUE ) > 0, ncol = 1) #TRUE means edge can be removed
  }) %>%
  do.call(cbind,.)
  s[RemoveEdge] <- NA
return(s)
}

#This function just creates a dataframe
CreateData <- function(n, seed){
  set.seed(seed)
  s <- matrix(rnorm(n^2), n) #%>% cor
  s <- s +abs(min(s))+0.001
  s[lower.tri(s)] = t(s)[lower.tri(s)]
  diag(s) <- 0
  return(s)
 }

#Using a small amount of data
s <- CreateData(100, 876)
RemoveTri(s)

#using a larger amount of data
s2 <- CreateData(4000, 876)
RemoveTri(s2)

l <- lineprof(RemoveTri(s))
shine(l)

1 Ответ

0 голосов
/ 29 сентября 2018

Поскольку матрица симметрична, процесс можно ускорить, только рассчитав нижнюю треугольную матрицу.Делая это, мы можем уменьшить количество вычислений с $ n ^ 3 $ до
$ \ frac {n} {6} (2n ^ 2 + 3n + 1) $, что дает отношение $ \ frac {(2n+1) (n + 1)} {6n ^ 2} $, что приводит к уменьшению общего количества вычислений примерно на 2/3 при большом n.

Скорректированная функция ниже.

Эта функция запускается медленно и ускоряется при вычислении большего количества строк.При малых значениях n она медленнее, чем исходная функция, из-за дополнительных издержек, но становится быстрее, когда n больше пары сотен. 

RemoveTri  <- function(s){
      Smat <- col(s) 

      RemoveEdge <- 1:ncol(s) %>%
      map(~{
        print(.x)
        TargetRows <- .x:ncol(s)
        LogicMat <- s[TargetRows,TargetRows, drop = F] + s[TargetRows,.x][Smat[1:length(TargetRows),1:length(TargetRows)]]  < s[TargetRows,.x]


        matrix(data = c(rep(NA, .x-1),rowSums(LogicMat, na.rm = TRUE ) > 0), ncol = 1) #TRUE means edge should be removed

      }) %>%
      do.call(cbind,.)

      RemoveEdge[upper.tri(RemoveEdge)]  <- t(RemoveEdge)[upper.tri(RemoveEdge)]

      s[RemoveEdge] <- NA 

    s

}
...