r 在Barabasi游戏中捐赠边缘以避免单身

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了r 在Barabasi游戏中捐赠边缘以避免单身相关的知识,希望对你有一定的参考价值。

#' Donate edges to degree-less vertices
#' 
#' Used to add edges to nodes that lack edges in graphs generated by power_signal_graph.  
#' A 'rich get poorer' approach is used, wherein nodes with many incoming edges 'donate'
#' an incoming edge to an edgeless node.
#' @param g an igraph output of lucy::power_law_sim
#' @return the graph rewired such that there are no degreeless vertices
donate_edges <- function(g){
  g <- name_vertices(g)
  singletons <- V(g)[igraph::degree(g) == 0]
  #'donators' are all nodes that have incoming edges
  candidate_donators <- V(g)[igraph::degree(g, mode = "in") > 1]
  i <- 0
  max_i <- length(singletons)
  while(test && i < max_i){
    i <- i + 1
    v <- V(g)[as.numeric(singletons)[1]]
    # Use power law to get selection probability. The more edges a donator has, the higher
    # its probability of selection.
    power_calc <- igraph::degree(g, mode = "in")[candidate_donators] ^ g$power + g$zero.appeal
    prob <- power_calc / sum(power_calc)
    # Select one of the donators with this probability
    donator <- V(g)[sample(candidate_donators$name, 1, prob = prob)]$name # select a donator
    donated_edge <- E(g)[to(V(g)[donator])] %>% # pick an edge to switch
      as.numeric %>%
      {.[
        lapply(., function(e) {
          x <- try(get_edge_vertex(g, e, "from"), TRUE)
          if(class(x) == "try-error") browser()
          return(x)
          }) %>%
          # only chose an edge for donating from nodes that have more than one edge
          lapply(function(v) length((igraph::neighborhood(g, 1, V(g)[v]))[[1]]) >= 2) %>%
          unlist
        ]} %>%
      sample(1) %>%
    {E(g)[.]}
    source_v <- get_edge_vertex(g, donated_edge, "from")
    source_v_name <- V(g)[source_v]$name
    # Remove the chosen edge.
    g <- delete.edges(g, donated_edge)
    # Add an edge from source of 
    g <- g + edge(source_v_name, V(g)[v]$name)
    g <- simplify(g)
    # Next iteration 
    singletons <- V(g)[igraph::degree(g) == 0]
    #'donators' are all nodes that have incoming edges
    candidate_donators <- V(g)[igraph::degree(g, mode = "in") > 1]
    test <- (length(singletons) > 0 && length(candidate_donators) > 0)
    igraphviz(g)
  }
  g %>%
    ensure_that(is.dag(.)) %>%
    ensure_that(is.simple(.))
}

以上是关于r 在Barabasi游戏中捐赠边缘以避免单身的主要内容,如果未能解决你的问题,请参考以下文章

避免掉落边缘

android是否会为了释放内存而杀死单身?

避免加入事实表的策略

Luck Club-SDT超级单身狗 区块链游戏

火山引擎边缘渲染,驱动游戏体验升级

江西理工大学南昌校区排名赛 E: 单身狗的种树游戏