1reduction <-
2function(x, operation, ...)
3    UseMethod("reduction")
4
5reduction.default <-
6function(x, operation, ...)
7    stop("Not implemented.")
8
9reduction.set <-
10function(x, operation = c("union", "intersection"), ...)
11{
12    operation <- match.arg(operation)
13    if (length(x) < 2L) return(x)
14    if (!all(sapply(x, is.cset)))
15        stop("reduction only defined on set of (c,g)sets.")
16
17    if (all(sapply(x, is.set))) {
18
19        dom <- .as.list(do.call(set_union, x))
20        x <- lapply(x, .make_list_elements)
21
22        members <-
23            binary_reduction(do.call(rbind, lapply(x, function(i) dom %in% i)),
24                             operation)
25
26        .make_set_from_list(.list_sort(apply(members, 1L,
27                                             function(i) .make_set_from_list(dom[i])
28                                             )
29                                       )
30                            )
31    } else if (all(sapply(x, is.gset))) {
32        clo <- closure(x, operation)
33        FUN <- function(e)
34            !isTRUE(gset_is_equal(closure(gset_difference(x, set(e)),
35                                          operation), clo))
36        as.set(Filter(FUN, .as.list(x)))
37    } else {
38        clo <- closure(x, operation)
39        FUN <- function(e)
40            !isTRUE(cset_is_equal(closure(cset_difference(x, set(e)),
41                                          operation), clo))
42        as.set(Filter(FUN, .as.list(x)))
43    }
44}
45
46binary_reduction <-
47function(x, operation = c("union", "intersection"))
48    .Call(sets_reduction, x,
49          pmatch(match.arg(operation), c("union", "intersection")))
50