#' triad census with node attributes
#'
#' @param g igraph object. should be a directed graph
#' @param vattr name of vertex attribute to be used
#' @return triad census with node attributes
#' @details The node attribute should be integers from 1 to max(attr).
#' The output is a named vector where the names are of the form Txxx-abc, where xxx corresponds to the standard triad census notation and "abc" are the attributes of the involved nodes.
#'
#' The implemented algorithm is comparable to the algorithm in Lienert et al.
#' @references Lienert, J., Koehly, L., Reed-Tsochas, F., & Marcum, C. S. (2019). An efficient counting method for the colored triad census. Social Networks, 58, 136-142.
#' @author David Schoch
#' @examples
#' library(igraph)
#' set.seed(112)
#' g <- sample_gnp(20, p = 0.3, directed = TRUE)
#' # add a vertex attribute
#' V(g)$type <- rep(1:2, each = 10)
#' triad_census_attr(g, "type")
#' @export
triad_census_attr <- function(g, vattr) {
    attr <- validate_vattr(g, vattr)
    A <- igraph::as_adjacency_matrix(g)

    # orbit codes (sorted triple) for each of the 64 directed triad realizations
    orbit_classes <- matrix(
        c(
             0,  0,  0,   2,  3,  1,   2,  1,  3,  11, 12, 12,
             3,  2,  1,   5,  5,  4,   6,  7,  8,  14, 15, 13,
             1,  2,  3,   7,  6,  8,  10, 10,  9,  23, 24, 22,
            12, 11, 12,  15, 14, 13,  24, 23, 22,  26, 26, 25,
             3,  1,  2,   6,  8,  7,   5,  4,  5,  14, 13, 15,
             9, 10, 10,  17, 18, 16,  17, 16, 18,  20, 19, 19,
             8,  7,  6,  21, 21, 21,  18, 16, 17,  30, 29, 31,
            22, 23, 24,  31, 30, 29,  28, 27, 28,  33, 32, 34,
             1,  3,  2,  10,  9, 10,   7,  8,  6,  23, 22, 24,
             8,  6,  7,  18, 17, 16,  21, 21, 21,  30, 31, 29,
             4,  5,  5,  16, 17, 18,  16, 18, 17,  27, 28, 28,
            13, 14, 15,  19, 20, 19,  29, 30, 31,  32, 33, 34,
            12, 12, 11,  24, 22, 23,  15, 13, 14,  26, 25, 26,
            22, 24, 23,  28, 28, 27,  31, 29, 30,  33, 34, 32,
            13, 15, 14,  29, 31, 30,  19, 19, 20,  32, 34, 33,
            25, 26, 26,  34, 33, 32,  34, 32, 33,  35, 35, 35
        ),
        ncol = 3,
        byrow = TRUE
    )
    tri_names <- c(
        "003", "012", "012", "021D", "012", "102", "021C", "111U",
        "012", "021C", "021U", "030T", "021D", "111U", "030T", "120U",
        "012", "021C", "102", "111U", "021U", "111D", "111D", "201",
        "021C", "030C", "111D", "120C", "030T", "120C", "120D", "210",
        "012", "021U", "021C", "030T", "021C", "111D", "030C", "120C",
        "102", "111D", "111D", "120D", "111U", "201", "120C", "210",
        "021D", "030T", "111U", "120U", "030T", "120D", "120C", "210",
        "111U", "120C", "201", "210", "120U", "210", "210", "300"
    )
    tri_names <- paste0("T", tri_names)
    attrcomb <- as.matrix(expand.grid(1:max(attr), 1:max(attr), 1:max(attr)))

    code_sort <- function(vorb, attr, i) {
        idx <- order(vorb, attr)
        vorbs <- vorb[idx]
        attrs <- attr[idx]
        if (all(vorbs == 21) && length(unique(attr)) == 3) {
            if (i == 39) {
                attrs <- rev(attrs)
            }
        }
        return(paste0(
            paste0(vorbs, collapse = ""),
            "-",
            paste0(attrs, collapse = "")
        ))
    }

    # Build all (orbit class, attribute combination) names into preallocated
    # vectors and deduplicate once. The "new" code (sorted orbits + attrs) maps
    # bijectively to its labelled name, so a single first-occurrence mask keeps
    # both vectors in lockstep.
    n_comb <- nrow(orbit_classes) * nrow(attrcomb)
    all_codes <- character(n_comb)
    all_labels <- character(n_comb)
    idx <- 1L
    for (i in seq_len(nrow(orbit_classes))) {
        for (j in seq_len(nrow(attrcomb))) {
            new <- code_sort(orbit_classes[i, ], attrcomb[j, ], i)
            all_codes[idx] <- new
            all_labels[idx] <- paste0(tri_names[i], "-", gsub(".*-", "", new))
            idx <- idx + 1L
        }
    }
    keep <- !duplicated(all_codes)
    triad_names <- all_codes[keep]
    triad_names1 <- all_labels[keep]

    triads <- rep(0L, length(triad_names))
    names(triads) <- triad_names
    triads <- triadCensusCol(A, attr, orbit_classes, triads)
    names(triads) <- triad_names1
    triads
}
