выборка подграфов из разных размеров с использованием igraph

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

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

tmp.neigh <- V(G)[unlist(neighborhood(G,1,seed))]$name
tmp.neigh <- setdiff(tmp.neigh, seed)

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

josilber <- function(size, num.rep, G) {
  score_fun <- function(vert) sum(vert$weight*vert$RWRNodeweight)/sqrt(sum(vert$RWRNodeweight^2))
  n <- length(V(G)$name)

  # Determine which nodes fall in sufficiently large connected components
  comp <- components(G)
  valid <- which(comp$csize[comp$membership] >= size)

  perm <- replicate(num.rep, {
    first.node <- sample(valid, 1)
    used <- (1:n) == first.node  # Is this node selected?
    neigh <- (1:n) %in% neighbors(G, first.node)  # Does each node neighbor our selections?
    for (iter in 2:size) {
      new.node <- sample(which(neigh & !used), 1)
      used[new.node] <- TRUE
      neigh[neighbors(G, new.node)] <- TRUE
    }
    score_fun(V(G)[used])
  })
  perm
}

для одной репликации это дает значительные ускорения по одной репликации кода в вопросе:

• для size=50 одна репликация занимает 0,3 секунды для этого кода и 3,8 секунды для опубликованного код
• для размера=100 одна репликация занимает 0,6 секунды для этого кода и 15,2 секунды для размещенного кода
• для size=200 одна репликация занимает 1,5 секунды для этого кода и 69,4 секунды для опубликованного кода
• для size=500 одна репликация для этого кода занимает 2,7 секунды (поэтому 1000 реплик должно занять около 45 минут); я не тестировал одну репликацию опубликованного кода.

как упоминалось в других ответах, распараллеливание может еще больше повысить производительность выполнения 1000 реплик для заданного размера графика. Следующие использует doParallel пакет для параллелизации повторяющегося шага (настройка в значительной степени идентична той, которую сделал @Chris в своем ответе):

library(doParallel)
cl <- makeCluster(4)
registerDoParallel(cl)
josilber2 <- function(size, num.rep, G) {
  score_fun <- function(vert) sum(vert$weight*vert$RWRNodeweight)/sqrt(sum(vert$RWRNodeweight^2))
  n <- length(V(G)$name)

  # Determine which nodes fall in sufficiently large connected components
  comp <- components(G)
  valid <- which(comp$csize[comp$membership] >= size)

  perm <- foreach (i=1:num.rep, .combine='c') %dopar% {
    library(igraph)
    first.node <- sample(valid, 1)
    used <- (1:n) == first.node  # Is this node selected?
    neigh <- (1:n) %in% neighbors(G, first.node)  # Does each node neighbor our selections?
    for (iter in 2:size) {
      new.node <- sample(which(neigh & !used), 1)
      used[new.node] <- TRUE
      neigh[neighbors(G, new.node)] <- TRUE
    }
    score_fun(V(G)[used])
  }
  perm
}

на моем Macbook Air,josilber(100, 1000, my_graph) занимает 670 секунд для запуска (это непараллельная версия), в то время как josilber2(100, 1000, my_graph) для запуска требуется 239 секунд (это параллельная версия, настроенная с 4 рабочими). Для size=100 случае, мы поэтому получили ускорение 20x от улучшений кода и дополнительное ускорение 3x от распараллеливания, для общего ускорения 60x.

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

1. удалите из графика любые узлы, которые не являются частью компонента такого размера, как вы ищете. Это действительно будет зависеть от вашей сетевой структуры, но похоже, что ваши сети являются генами, поэтому, вероятно, есть много генов с очень низкой степенью, и вы можете получить некоторые ускорения, удалив их. Что-то вроде этого кода:

   cgraph <- clusters(G)
   tooSmall <- which(cgraph$csize < size)
   toKeep <- setdiff(1:length(V(G)), which(cgraph$membership %in% tooSmall))
   graph <- induced.subgraph(G, vids=toKeep)
   

2. рассмотрите возможность запуска этого параллельно, чтобы воспользоваться несколькими ядрами. Например, используя parallel пакета и mclapply.

   library(parallel)
   genesets.length<- seq(5, 500)
   names(genesets.length) <- genesets.length
   genesets.length.null.dis <- mclapply(genesets.length, mc.cores=7,
                                        function(length) {
                                          random_network(size=length, G=my_graph)
                                        })
   

Я думаю, что было бы гораздо эффективнее использовать функцию cliques в igraph, поскольку клика является подграфом полностью связанных узлов. Просто установите min и max равными размеру подграфа, который вы ищете, и он вернет все клики размера 5. Вы можете взять любое подмножество из них, которое отвечает вашим потребностям. К сожалению, в Примере erdos-Renyi graph вы сгенерировали часто, когда самая большая клика меньше 5, поэтому это не будет работать для примера. Однако, он должен отлично работать для реальной сети, которая демонстрирует больше кластеризации, чем график Эрдоса-Рени, как это, скорее всего, делает ваш.

library(igraph)
##Should be 0.003, not 0.0003 (145000/choose(10000,2))
my_graph <- erdos.renyi.game(10000, 0.003)

cliques(my_graph,min=5,max=5)

у вас есть ряд проблем с вашим кодом(вы не предварительно выделяете векторы и т. д.). Пожалуйста, посмотрите код, который я придумал ниже. Однако я протестировал его только до подграфа размера 100. Тем не менее, экономия скорости увеличивается по мере увеличения размера подграфа по сравнению с вашим кодом. Вы должны установить foreach пакет также. Я запустил это на ноутбуке с ядрами 4, 2.1 GHz.

random_network_new <- function(gsize, G) {
  score_fun <- function(g) {
    subsum <- sum(V(g)$weight * V(g)$RWRNodeweight) / sqrt(sum(V(g)$RWRNodeweight^2))
  }

  genes.idx <- V(G)$name

  perm <- foreach (i=seq_len(1e3), .combine='c') %dopar% {
    seed <- rep(0, length=gsize)
    seed[1] <- sample(genes.idx, 1)

    for (j in 2:gsize) {
      tmp.neigh <- neighbors(G, as.numeric(seed[j-1]))
      tmp.neigh <- setdiff(tmp.neigh, seed)
      if (length(tmp.neigh) > 0) {
        seed[j] <- sample(tmp.neigh, 1)
      } else {
        break
      }
    }
    score_fun(induced.subgraph(G, seed))
  }
  perm
}

обратите внимание, что я переименовал функцию random_network_new и аргумент gsize.

system.time(genesets <- random_network_new(gsize=100, G=my_graph))                                            
   user   system  elapsed 
1011.157    2.974  360.925 
system.time(genesets <- random_network_new(gsize=50, G=my_graph))
   user  system elapsed 
822.087   3.119 180.358 
system.time(genesets <- random_network_new(gsize=25, G=my_graph))
   user  system elapsed 
379.423   1.130  74.596 
system.time(genesets <- random_network_new(gsize=10, G=my_graph))
   user  system elapsed 
144.458   0.677  26.508 

один пример использования вашего кода (мой более 10 раз быстрее для размера подграфа 10; это было бы намного быстрее с большими подграфами):

system.time(genesets_slow <- random_network(10, my_graph))
   user  system elapsed 
350.112   0.038 350.492