OKlibrary  0.2.1.6
BasicNotions.mac
Go to the documentation of this file.
00001 /* Oliver Kullmann, 16.1.2009 (Swansea) */
00002 /* Copyright 2009, 2010 Oliver Kullmann
00003 This file is part of the OKlibrary. OKlibrary is free software; you can redistribute
00004 it and/or modify it under the terms of the GNU General Public License as published by
00005 the Free Software Foundation and included in this library; either version 3 of the
00006 License, or any later version. */
00007 
00022 oklib_include("OKlib/ComputerAlgebra/Graphs/Lisp/Basic.mac")$
00023 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/SetSystems.mac")$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")$
00025 
00026 
00027 /* ***********************
00028    * Fundamental notions *
00029    ***********************
00030 */
00031 
00032 /* A "vertex-biclique" ("vbc") in a graph is a pair of sets of vertices
00033    forming a biclique.
00034    An "ordered vertex-biclique" ("ovbc") uses lists of vertices instead.
00035 */
00036 
00037 /* The following tests assume that G is a well-formed graph
00038    (of its type).
00039 */
00040 
00041 vbc_gl_p(B,G) := listp(B) and is(length(B)=2) and
00042  every_s(setp, B) and disjointp(B[1],B[2]) and
00043  every_s(lambda([b], subsetp(b,G[1])), B) and
00044  subsetp(map(setify,cartesian_product(B[1],B[2])), G[2])$
00045 
00046 /* CHANGE: the concept of a multigraph changed.
00047    Instead of the subset-test we check then whether the edge-function
00048    is non-zero on all potential edges.
00049  */
00050 vbc_mugl_p(B,G) := listp(B) and is(length(B)=2) and
00051  every_s(setp, B) and disjointp(B[1],B[2]) and
00052  every_s(lambda([b], subsetp(b,G[1])), B) and
00053  subsetp(map(setify,cartesian_product(B[1],B[2])), G[2])$
00054 
00055 vbc_gg_p(B,G) := listp(B) and is(length(B)=2) and
00056  every_s(setp, B) and disjointp(B[1],B[2]) and
00057  every_s(lambda([b], subsetp(b,G[1])), B) and
00058  subsetp(map(setify,cartesian_product(B[1],B[2])), map(G[3],G[2]))$
00059 
00060 
00061 vbc_dgl_p(B,G) := listp(B) and is(length(B)=2) and
00062  every_s(setp, B) and disjointp(B[1],B[2]) and
00063  every_s(lambda([b], subsetp(b,G[1])), B) and
00064  subsetp(cartesian_product(B[1],B[2]), G[2])$
00065 
00066 
00067 /* An "edge-biclique" ("ebc") in a graph is a set of edges
00068    forming a biclique.
00069    An "ordered edge-biclique" ("oebc") uses lists of edges instead.
00070 */
00071 
00072 /* The following tests assume that G is a well-formed graph
00073    (of its type).
00074 */
00075 
00076 ebc_gg_p(B,G) := setp(B) and subsetp(B,G[2]) and
00077  block([S : edge_induced_subgraph_gg(B,G)],
00078   not parallel_edges_gg_p(S) and completebipartite_gg_p(S))$
00079 
00080 
00081 /* *********************
00082    * Maximal bicliques *
00083    *********************
00084 */
00085 
00086 /* Given a vertex biclique B in G, extend it to a maximal biclique
00087    by iteratively extending it with the first possible vertex v outside of B,
00088    where first v is considered to extend the first part in the biclique, and 
00089    then the second part. Only at the beginning the process is different:
00090    here the algorithm tries to establish two non-empty parts of B
00091    (using again the first possible vertices).
00092 */
00093 maximal_bc_gl(B,G) := 
00094  if emptyp(G[2]) then
00095   if not emptyp(B[2]) then [{},G[1]]
00096     else [G[1],{}]
00097  else (
00098   if B = [{},{}] then 
00099     B : [{first_element(first_element(G[2]))},
00100          {second_element(first_element(G[2]))}]
00101   elseif not emptyp(B[1]) and emptyp(B[2]) then block([found : false],
00102     for v in setdifference(G[1],B[1]) unless found do
00103       if subsetp(map(setify,cartesian_product(B[1],{v})),G[2]) then (
00104         B[2] : {v}, found : true))
00105   elseif emptyp(B[1]) and not emptyp(B[2]) then block([found : false],
00106     for v in setdifference(G[1],B[2]) unless found do
00107       if subsetp(map(setify,cartesian_product(B[2],{v})),G[2]) then  (
00108         B[1] : {v}, found : true)),
00109   /* Now established: B[1] and B[2] are not empty. */
00110   for v in setdifference(G[1],union(B[1],B[2])) do 
00111     if vbc_gl_p([adjoin(v,B[1]),B[2]],G) then
00112       B[1] : adjoin(v,B[1])
00113     else if vbc_gl_p([B[1],adjoin(v,B[2])],G) then
00114       B[2] : adjoin(v,B[2]),
00115   B)$
00116 
00117 
00118 /* *******************
00119    * Biclique covers *
00120    *******************
00121 */
00122 
00123 /* max_bc_cover_gl takes a graph with loops G and
00124    returns a biclique cover by maximal bicliques of G,
00125    obtained by repeatedly extending non-covered edges
00126    to maximal bicliques.
00127 */
00128 max_bc_cover_gl(G) := block([GNL : G, i, LB, rest, fedge, reiterate, induMB],
00129   LB : [],
00130   EP : {},
00131   GNL : gl2g(G),
00132   rest : setdifference(GNL[2],EP),
00133   reiterate : not(rest = {}),
00134   for i : 1 while reiterate = true do block([B, S1, S2, MB],
00135     fedge : listify(rest)[1],
00136     S1 : {listify(fedge)[1]},
00137     S2 : {listify(fedge)[2]},
00138     B : [S1,S2],
00139     MB : maximal_bc_gl(B,G),
00140     LB : cons(MB,LB),
00141     induMB : map(setify,cartesian_product(MB[1],MB[2])),
00142     rest : setdifference(rest,induMB),
00143     reiterate : not(rest = {})
00144   ),
00145   return(LB))$
00146 
00147