transitivity_directed.R

library(igraph)
library(compiler)

transitivity_directed <- function(g, method = "weak"){
    # _g_ is an igraph graph object
    # _method_ is the technique of measuring transitivity.
        # "Weak" is the most common understanding of transitivity, so that's the one used here.
        # "Weak census" returns the counts, not the proportion.
        # Once I find a convenient table showing the weights for vacuous transitive triples and see the formula, I'll include strong transitivity.

    if (is.directed(g) == FALSE){
        warning("Entered an undirected graph into transitivity_directed(). Returned transitivity(g).")
        return(transitivity(g))
        }
    acceptable_methods <- c("weak", "weakcensus")
    if (method %in% acceptable_methods == FALSE)
        stop(paste("_method_ must be in c(\"", paste(acceptable_methods, collapse = "\", \""), "\")", sep = ""))
    # See Wasserman and Faust (1994:573)
    weight_mat <- data.frame(row.names = c("003", "012", "102", "021D", "021U", "021C", "111D", "111U", "030T", "030C", "201", "120D", "120U", "120C", "210", "300"))
    weight_mat$b_in <- c(0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 2, 1, 1, 2, 3)
    weight_mat$b_out <- c(0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 2, 1, 2, 3)
    weight_mat$m <- c(0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 2, 1, 1, 1, 2, 3)
    weight_mat$a <- c(0, 1, 0, 2, 2, 2, 1, 1, 3, 3, 0, 2, 2, 2, 1, 0)
    weight_mat$n <- c(3, 2, 2, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0)
    weight_mat$c <- c(0, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 6)
    weight_mat$Trans <- c(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 2, 1, 3, 6)
    #weight_mat$Vac_trans <- c(6, 6, 6, 6, 6, 5, 5, 5, 5, 3, 4, 4, 4, 3, 2, 0)
    weight_mat$Intrans <- c(0, 0, 0, 0, 0, 1, 1, 1, 0, 3, 2, 0, 0, 2, 1, 0)
    weight_mat$Close_Friends_Disagreeing <- c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0, 1, 1, 0)

    tc <- triad.census(g)
    if (method == "weakcensus"){
        transcounts <- sum(weight_mat$Trans * tc)
        return(transcounts)
        }
    else if (method == "weak"){
        transcounts <- sum(weight_mat$Trans * tc)
        intranscounts <- sum(weight_mat$Intrans * tc)
        return(transcounts / (transcounts + intranscounts))
        }
    }
transitivity_directed <- cmpfun(transitivity_directed)