### R code from vignette source 'relations.Rnw' ################################################### ### code chunk number 1: relations.Rnw:53-56 ################################################### options(width = 80) library("sets") library("relations") ################################################### ### code chunk number 2: relationgenerator ################################################### ## A relation created by specifying the graph: R <- relation(graph = data.frame(A = c(1, 1:3), B = c(2:4, 4))) ## extract domain relation_domain(R) ## extract graph relation_graph(R) ## both ("a pair of domain and graph" ...) as.tuple(R) ## extract incidence relation_incidence(R) ## (Almost) the same using the set specification ## (the domain labels are missing). R <- relation(graph = set(tuple(1,2), tuple(1,3), tuple(2,4), tuple(3,4))) ## equivalent to: ## relation(graph = list(1:2, c(1,3), c(2,4), c(3,4))) relation_incidence(R) ## Domains can be composed of arbitrary R objects: R <- relation(domain = set(c, "test"), graph = set(tuple(c, c), tuple(c, "test"))) relation_incidence(R) as.relation(1:3) relation_graph(as.relation(c(TRUE, FALSE, TRUE))) relation_graph(as.relation(factor(c("A", "B", "A")))) ################################################### ### code chunk number 3: relations.Rnw:140-142 ################################################### relation_graph(as.relation(factor(c(X = "A", Y = "B", Z = "A")))) relation_graph(as.relation(factor(c("A", "B", "C")))) ################################################### ### code chunk number 4: charfun ################################################### divides <- function(a, b) b %% a == 0 R <- relation(domain = list(1 : 10, 1 : 10), charfun = divides) R "%|%" <- relation_charfun(R) 2L %|% 6L 2:4 %|% 6L 2L %|% c(2:3, 6L) "%|%"(2L, 6L) ################################################### ### code chunk number 5: predicates ################################################### R <- as.relation(1:5) relation_is(R, "binary") relation_is(R, "transitive") relation_is(R, "partial_order") ################################################### ### code chunk number 6: ops1 ################################################### x <- matrix(0, 3L, 3L) R1 <- as.relation(row(x) >= col(x)) R2 <- as.relation(row(x) <= col(x)) R3 <- as.relation(row(x) < col(x)) relation_incidence(max(R1, R2)) relation_incidence(min(R1, R2)) R3 < R2 relation_dissimilarity(min(R1, R2), max(R1, R2)) ################################################### ### code chunk number 7: ops2 ################################################### relation_incidence(! R1) relation_incidence(R1 * R2) relation_incidence(t(R2)) ################################################### ### code chunk number 8: plot ################################################### ps <- 2 ^ set("a", "b", "c") inc <- set_outer(ps, "<=") if (require("Rgraphviz")) plot(relation(incidence = inc)) ################################################### ### code chunk number 9: plotfig ################################################### ps <- 2 ^ set("a", "b", "c") inc <- set_outer(ps, "<=") if (require("Rgraphviz")) plot(relation(incidence = inc)) ################################################### ### code chunk number 10: relations.Rnw:371-375 ################################################### data("Cetacea") ind <- vapply(Cetacea, function(s) all(!is.na(s)), TRUE) relations <- as.relation_ensemble(Cetacea[, ind]) print(relations) ################################################### ### code chunk number 11: relations.Rnw:380-383 ################################################### any(duplicated(relations)) thrice <- c(rep(relations, 2L), relations) all.equal(unique(thrice), relations) ################################################### ### code chunk number 12: relations.Rnw:388-389 ################################################### all.equal(thrice[!duplicated(thrice)], relations) ################################################### ### code chunk number 13: relations.Rnw:394-395 ################################################### relation_dissimilarity(relations[1 : 2], relations["CLASS"]) ################################################### ### code chunk number 14: relations.Rnw:399-401 ################################################### d <- relation_dissimilarity(relations) sort(as.matrix(d)[, "CLASS"])[-1L] ################################################### ### code chunk number 15: relations.Rnw:406-408 ################################################### complement <- !relations complement ################################################### ### code chunk number 16: projection ################################################### ## projection Person <- data.frame(Name = c("Harry", "Sally", "George", "Helena", "Peter"), Age = c(34, 28, 29, 54, 34), Weight = c(80, 64, 70, 54, 80), stringsAsFactors = FALSE) Person <- as.relation(Person) relation_table(Person) relation_table(relation_projection(Person, c("Age", "Weight"))) ################################################### ### code chunk number 17: selection ################################################### ## selection relation_table(R1 <- relation_selection(Person, Age < 29)) relation_table(R2 <- relation_selection(Person, Age >= 34)) relation_table(R3 <- relation_selection(Person, Age == Weight)) ################################################### ### code chunk number 18: unioncomplement ################################################### ## union relation_table(R1 %U% R2) ## works only for the same domains: relation_table(R2 | R3) ## complement relation_table(Person - R2) ################################################### ### code chunk number 19: intersectionsymdiff ################################################### ## intersection relation_table(relation_intersection(R2, R3)) ## works only for the same domains: relation_table(R2 & R3) ## symmetric difference relation_table(relation_symdiff(R2, R3)) ################################################### ### code chunk number 20: cartesian ################################################### ## cartesian product Employee <- data.frame(Name = c("Harry", "Sally", "George", "Harriet", "John"), EmpId = c(3415, 2241, 3401, 2202, 3999), DeptName = c("Finance", "Sales", "Finance", "Sales", "N.N."), stringsAsFactors = FALSE) Employee <- as.relation(Employee) relation_table(Employee) Dept <- data.frame(DeptName = c("Finance", "Sales", "Production"), Manager = c("George", "Harriet", "Charles"), stringsAsFactors = FALSE) Dept <- as.relation(Dept) relation_table(Dept) relation_table(Employee %><% Dept) ################################################### ### code chunk number 21: division ################################################### ## division Completed <- data.frame(Student = c("Fred", "Fred", "Fred", "Eugene", "Eugene", "Sara", "Sara"), Task = c("Database1", "Database2", "Compiler1", "Database1", "Compiler1", "Database1", "Database2"), stringsAsFactors = FALSE) Completed <- as.relation(Completed) relation_table(Completed) DBProject <- data.frame(Task = c("Database1", "Database2"), stringsAsFactors = FALSE) DBProject <- as.relation(DBProject) relation_table(DBProject) relation_table(Completed %/% DBProject) ## division remainder relation_table(Completed %% DBProject) ################################################### ### code chunk number 22: naturaljoin ################################################### ## Natural join relation_table(Employee %|><|% Dept) ## left (outer) join relation_table(Employee %=><% Dept) ## right (outer) join relation_table(Employee %><=% Dept) ## full outer join relation_table(Employee %=><=% Dept) ################################################### ### code chunk number 23: semijoin ################################################### ## semijoin relation_table(Employee %|><% Dept) relation_table(Employee %><|% Dept) ################################################### ### code chunk number 24: antijoin ################################################### ## antijoin relation_table(Employee %|>% Dept) relation_table(Employee %<|% Dept) ################################################### ### code chunk number 25: consensus1a ################################################### data("Felines") relations <- as.relation_ensemble(Felines) ################################################### ### code chunk number 26: consensus1b ################################################### E <- relation_consensus(relations, "symdiff/E") ids <- relation_class_ids(E) split(rownames(Felines), ids) ################################################### ### code chunk number 27: consensus2a ################################################### pm <- matrix(c(0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0), nrow = 5L, byrow = TRUE, dimnames = list(letters[1:5], letters[1:5])) R <- as.relation(t(pm)) relation_incidence(R) relation_is(R, "tournament") ################################################### ### code chunk number 28: consensus2b ################################################### L <- relation_consensus(R, "symdiff/L") relation_incidence(L) ################################################### ### code chunk number 29: relations.Rnw:761-762 ################################################### relation_class_ids(L) ################################################### ### code chunk number 30: consensus2c ################################################### L <- relation_consensus(R, "symdiff/L", control = list(all = TRUE)) print(L) if(require("Rgraphviz")) plot(L) ################################################### ### code chunk number 31: relations.Rnw:773-774 ################################################### lapply(L, relation_class_ids) ################################################### ### code chunk number 32: consensus2d ################################################### W3 <- relation_consensus(R, "symdiff/W", control = list(k = 3)) relation_incidence(W3) relation_class_ids(W3) ################################################### ### code chunk number 33: consensusfig ################################################### if(require("Rgraphviz")) plot(L)