binning <- 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))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.