R/binning_2.R

In thongphamthe/mcPAFit: Estimating Preferential Attachment from a Single Network Snapshot in Constant Time

binning_2 <- function(deg.max, G = 100, final_deg, outlier_prop = 0.975) {
  #k_1_thresh <- quantile(final_deg, probs = outlier_prop) 
  #start_deg  <- round(k_1_thresh)
  start_deg <- 0
  if (G <= deg.max - start_deg + 1) {
    if (1 == G) {
      base <- deg.max - start_deg + 1
      interval_length <- deg.max - start_deg + 1
    }
    else {
      is.warn <- options()$warn
      options(warn = -1)
      ff <- function(x) {
        deg.max - start_deg + 1 - sum(floor(x^(0:(G - 
                                                    1))))
      }
      base <- uniroot(ff, interval = c(1 + 1e-15, deg.max - 
                                         start_deg + G + 1.1), tol = .Machine$double.eps)$root
      options(warn = is.warn)
      interval_length <- floor(base^(0:(G - 1)))
    }
  }
  else if ( (0 == G) || (G > deg.max - start_deg + 1)) {
    G <- deg.max - start_deg + 1
    interval_length <- rep(1, G)
    base <- 1
  }
  
  bin_vector <- rep(G + start_deg - 1, deg.max + 1)
  begin_deg <- c(start_deg, start_deg + cumsum(interval_length)[-G])
  end_deg <- begin_deg + interval_length - 1
  if (start_deg > 0) 
    bin_vector[1:start_deg] <- 0:(start_deg - 1)
  for (i in 1:G) bin_vector[(begin_deg[i]:end_deg[i]) + 1] <- i + start_deg - 1
  
  names(bin_vector) <- 0:(length(bin_vector) - 1) 
  if (start_deg  > 1) {
    center_bin        <- c(0:(start_deg - 1),sqrt(begin_deg * end_deg))
  } else center_bin <- sqrt(begin_deg * end_deg)
  G <- max(bin_vector) + 1
  return(list(bin = bin_vector, center_bin = center_bin, 
              start = begin_deg, end = end_deg, G = G))
}