dwww Home | Show directory contents | Find package

context("Maximal cliques")

mysort <- function(x) {
  xl <- sapply(x, length)
  x <- lapply(x, sort)
  xc <- sapply(x, paste, collapse="-")
  x[order(xl, xc)]
}

unvs <- function(x) lapply(x, as.vector)

bk4 <- function(graph, min=0, max=Inf) {

  Gamma <- function(v) { neighbors(graph, v) }

  bkpivot <- function(PX, R) {
    P <- if (PX$PE >= PX$PS) { PX$PX[PX$PS:PX$PE] } else { numeric() }
    X <- if (PX$XE >= PX$XS) { PX$PX[PX$XS:PX$XE] } else { numeric() }
    if (length(P) == 0 && length(X) == 0) {
      if (length(R) >= min && length(R) <= max) { list(R) } else { list() }
    } else if (length(P) != 0) {
      psize <- sapply(c(P, X), function(u)
                      length(intersect(P, Gamma(u))))
      u <- c(P, X)[which.max(psize)]

      pres <- list()
      for (v in setdiff(P, Gamma(u))) {
        
        p0 <- if (PX$PS > 1) { PX$PX[1:(PX$PS-1)] } else { numeric() }
        p1 <- setdiff(P, Gamma(v))
        p2 <- intersect(P, Gamma(v))
        x1 <- intersect(X, Gamma(v))
        x2 <- setdiff(X, Gamma(v))
        x0 <- if (PX$XE < length(PX$PX)) {
          PX$PX[(PX$XE+1):length(PX$PX)]
        } else {
          numeric()
        }

        newPX <- list(PX=c(p0, p1, p2, x1, x2, x0),
                      PS=length(p0) + length(p1) + 1,
                      PE=length(p0) + length(p1) + length(p2),
                      XS=length(p0) + length(p1) + length(p2) + 1,
                      XE=length(p0) + length(p1) + length(p2) + length(x1))
        
        pres <- c(pres, bkpivot(newPX, c(R, v)))

        vpos <- which(PX$PX==v)
        tmp <- PX$PX[PX$PE]
        PX$PX[PX$PE] <- v
        PX$PX[vpos] <- tmp
        PX$PE <- PX$PE - 1
        PX$XS <- PX$XS - 1
        P <- if (PX$PE >= PX$PS) { PX$PX[PX$PS:PX$PE] } else { numeric() }
        X <- if (PX$XE >= PX$XS) { PX$PX[PX$XS:PX$XE] } else { numeric() }
        if (any(duplicated(PX$PX))) { stop("foo2") }
      }
      pres
    }
  }

  res <- list()
  cord <- order(coreness(graph))
  for (v in seq_along(cord)) {
    if (v != length(cord)) {
      P <- intersect(Gamma(cord[v]), cord[(v+1):length(cord)])
    } else {
      P <- numeric()
    }
    if (v != 1) {
      X <- intersect(Gamma(cord[v]), cord[1:(v-1)])
    } else {
      X <- numeric()
    }
    PX <- list(PX=c(P, X), PS=1, PE=length(P),
               XS=length(P)+1, XE=length(P)+length(X))
    res <- c(res, bkpivot(PX, cord[v]))
  }
  lapply(res, as.integer)
}

#################################################################

test_that("Maximal cliques work", {
  library(igraph)
  set.seed(42)
  G <- sample_gnm(1000, 1000)
  cli <- make_full_graph(10)
  for (i in 1:10) {
    G <- permute(G, sample(vcount(G)))
    G <- G %u% cli
  }
  G <- simplify(G)

  cl1 <- mysort(bk4(G, min=3))
  cl2 <- mysort(unvs(max_cliques(G, min=3)))

  expect_that(cl1, is_identical_to(cl2))
})

test_that("Maximal cliques work for subsets", {
  library(igraph)
  set.seed(42)
  G <- sample_gnp(100, .5)

  cl1  <- mysort(unvs(max_cliques(G, min=8)))

  c1 <- unvs(max_cliques(G, min=8, subset=1:13))
  c2 <- unvs(max_cliques(G, min=8, subset=14:100))
  cl2 <- mysort(c(c1, c2))
  
  expect_that(cl1, is_identical_to(cl2))
})

test_that("Counting maximal cliques works", {
  library(igraph)
  set.seed(42)
  G <- sample_gnp(100, .5)

  cl1  <- count_max_cliques(G, min=8)
          
  c1 <- count_max_cliques(G, min=8, subset=1:13)
  c2 <- count_max_cliques(G, min=8, subset=14:100)
  cl2 <- c1+c2
  
  expect_that(cl1, is_identical_to(cl2))
})

Generated by dwww version 1.15 on Sat May 18 14:54:16 CEST 2024.