OKlibrary  0.2.1.6
Basic.mac
Go to the documentation of this file.
00001 /* Oliver Kullmann, 5.1.2008 (Swansea) */
00002 /* Copyright 2008, 2009, 2010, 2011 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/Hypergraphs/Lisp/SetSystems.mac")$
00023 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/HashMaps.mac")$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")$
00025 oklib_include("OKlib/ComputerAlgebra/Graphs/Lisp/Statistics.mac")$
00026 
00027 oklib_plain_include(graphs)$
00028 
00029 
00030 /* ***********************
00031    * Fundamental notions *
00032    ***********************
00033 */
00034 
00035 /* A "graph" is a 2-element list, consisting of the set of
00036    vertices, and a set of 2-element vertex sets.
00037    A "graph with loops" also allows 1-element vertex sets.
00038 */
00039 
00040 /* A "digraph" is a 2-element list, consisting of the set of vertices,
00041    and a set of 2-element vertex lists with different elements.
00042    A "digrap with loops" also allows the elements to be identical.
00043 */
00044 
00045 /* A "multigraph" is a triple [V,E,f] such that [V,E] is a graph,
00046    and such that f is a function which assigns to every edge its
00047    cardinality, a natural number (>0).
00048    A "multigraph with loops" allows loops.
00049    CHANGE: this should change to a pair [V,f], such that f({a,b})
00050    is the multiplicity >= 0 of edge {a,b}.
00051 */
00052 
00053 /* A "multi-digraph" is similarly a triple [V,E,f] such that [V,E] is
00054    is digraph; and a "multi-digraph with loops" allows loops.
00055    CHANGE: similarly, this should change to a pair [V,f], where
00056    f([a,b]) is the multiplicity >= 0 of arc [a,b].
00057 */
00058 
00059 /* A "general graph" is a triple [V,E,f], where f maps each element of
00060    E to a 1- or 2-element subset of V.
00061    For a "general digraph" f yields lists of length 1 or 2.
00062 */
00063 
00064 /* The ordered versions of all the above notions use lists instead of
00065    sets, but without repetition.
00066 */
00067 
00068 /* See "Providing basic test cases" in
00069    ComputerAlgebra/Graphs/Lisp/tests/Basic.mac
00070    for basic examples.
00071 */
00072 
00073 
00074 /* ************************************
00075    * Checking the defining properties *
00076    ************************************
00077 */
00078 
00079 g_p(G) := listp(G) and is(length(G)=2) and setp(G[1]) and setp(G[2]) and 
00080   every_s(lambda([e], setp(e) and is(length(e) = 2) and subsetp(e,G[1])), G[2])$
00081 gl_p(G) := listp(G) and is(length(G)=2) and setp(G[1]) and setp(G[2]) and 
00082   every_s(lambda([e], setp(e) and elementp(length(e),{1,2}) and subsetp(e,G[1])),G[2])$
00083 dg_p(G) := listp(G) and is(length(G)=2) and setp(G[1]) and setp(G[2]) and 
00084   every_s(lambda([e], listp(e) and is(length(e)=2 and e[1]#e[2]) and subsetp(setify(e),G[1])), G[2])$
00085 dgl_p(G) := listp(G) and is(length(G)=2) and setp(G[1]) and setp(G[2]) and 
00086   every_s(lambda([e], listp(e) and is(length(e)=2) and subsetp(setify(e),G[1])), G[2])$
00087 mug_p(G) := listp(G) and is(length(G)=3) and g_p([G[1],G[2]]) and
00088   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00089 mugl_p(G) := listp(G) and is(length(G)=3) and gl_p([G[1],G[2]]) and
00090   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00091 mudg_p(G) := listp(G) and is(length(G)=3) and dg_p([G[1],G[2]]) and
00092   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00093 mudgl_p(G) := listp(G) and is(length(G)=3) and dgl_p([G[1],G[2]]) and
00094   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00095 gg_p(G) := listp(G) and is(length(G)=3) and setp(G[1]) and setp(G[2]) and
00096   every_s(lambda([e], block([s : G[3](e)],
00097     setp(s) and elementp(length(s),{1,2}) and subsetp(s,G[1]))), G[2])$
00098 gdg_p(G) := listp(G) and is(length(G)=3) and setp(G[1]) and setp(G[2]) and
00099   every_s(lambda([e], block([l : G[3](e)],
00100     listp(l) and is(length(l)=2) and subsetp(setify(l),G[1]))), G[2])$
00101 
00102 og_p(G) := listp(G) and is(length(G)=2) and listnorep_p(G[1]) and listnorep_p(G[2]) and
00103   every_s(lambda([e], setp(e) and is(length(e) = 2) and subsetp(e,setify(G[1]))), G[2])$
00104 ogl_p(G) := listp(G) and is(length(G)=2) and listnorep_p(G[1]) and listnorep_p(G[2]) and 
00105   every_s(lambda([e], setp(e) and elementp(length(e),{1,2}) and subsetp(e,setify(G[1]))), G[2])$
00106 odg_p(G) := listp(G) and is(length(G)=2) and listnorep_p(G[1]) and listnorep_p(G[2]) and 
00107   every_s(lambda([e], listp(e) and is(length(e)=2 and e[1]#e[2]) and subsetp(setify(e),setify(G[1]))), G[2])$
00108 odgl_p(G) := listp(G) and is(length(G)=2) and listnorep_p(G[1]) and listnorep_p(G[2]) and 
00109   every_s(lambda([e], listp(e) and is(length(e)=2) and subsetp(setify(e),setify(G[1]))), G[2])$
00110 omug_p(G) := listp(G) and is(length(G)=3) and og_p([G[1],G[2]]) and
00111   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00112 omugl_p(G) := listp(G) and is(length(G)=3) and ogl_p([G[1],G[2]]) and
00113   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00114 omudg_p(G) := listp(G) and is(length(G)=3) and odg_p([G[1],G[2]]) and
00115   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00116 omudgl_p(G) := listp(G) and is(length(G)=3) and odgl_p([G[1],G[2]]) and
00117   every_s(lambda([e], block([n : G[3](e)], integerp(n) and n > 0)), G[2])$
00118 ogg_p(G) := listp(G) and is(length(G)=3) and listnorep_p(G[1]) and listnorep_p(G[2]) and
00119   every_s(lambda([e], block([s : G[3](e)],
00120     setp(s) and elementp(length(s),{1,2}) and subsetp(s,setify(G[1])))), G[2])$
00121 ogdg_p(G) := listp(G) and is(length(G)=3) and listnorep_p(G[1]) and listnorep_p(G[2]) and
00122   every_s(lambda([e], block([l : G[3](e)],
00123     listp(l) and is(length(l)=2) and subsetp(setify(l),setify(G[1])))), G[2])$
00124 
00125 
00126 /* *********************
00127    * Checking equality *
00128    *********************
00129 */
00130 
00131 /* Equality checking for (directed) graphs (with loops) happens via normal
00132    "syntactical" equality testing, however for multigraphs and general
00133    graphs this would demand that the terms for the edge functions are equal,
00134    and so here we define special equality tests.
00135 */
00136 /* G1, G2, can be of arbitrary but identical graph-type: */
00137 gr_equalp(G1,G2) := if length(G1)=2 then is(G1 = G2) else
00138  is(G1[1] = G2[1] and G1[2] = G2[2]) and
00139   every_s(lambda([e],is(G1[3](e)=G2[3](e))), G1[2])$
00140 
00141 
00142 /* **************
00143    * Promotions *
00144    **************
00145 */
00146 
00147 /* Promotions g -> gl and mug -> mugl happen implicitly. */
00148 
00149 /* Works for g2mug, gl2mugl, og2omug, ogl2omugl, dg2mudg, dgl2mudgl, odg2omudg,
00150    odgl2omudgl: */
00151 generic_g2mug(G) := [G[1], G[2], lambda([e],1)]$
00152 /* Works for g2gg, gl2gg, og2ogg, ogl2ogg, dg2gdg, dgl2gdg, odg2ogdg,
00153    odgl2ogdg: */
00154 generic_g2gg(G) := [G[1], G[2], identity]$
00155 /* Works for mug2gg, mugl2gg, mudg2gdg, mudgl2gdg: */
00156 generic_mug2gg(G) := block([L : listify(G[2])],
00157   [G[1],
00158    setify(create_list([e,i], e,L, i,1,G[3](e))),
00159    first
00160   ])$
00161 /* Works for omug2ogg, omugl2ogg, omudg2ogdg, omudgl2ogdg: */
00162 generic_omug2ogg(G) := 
00163   [G[1], 
00164    create_list([e,i], e,G[2], i,1,G[3](e)),
00165    first
00166   ]$
00167 /* Works for g2og, gl2ogl, dg2odg, dgl2odgl: */
00168 generic_g2og(G) := [listify(G[1]), listify(G[2])]$
00169 /* Works for mug2omug, mugl2omugl, mudg2omudg, mudgl2omudgl, gg2ogg, gdg2ogdg: */
00170 generic_gg2ogg(G) := [listify(G[1]), listify(G[2]), G[3]]$
00171 
00172 g2mug(G) := generic_g2mug(G)$
00173 gl2mugl(G) := generic_g2mug(G)$
00174 g2gg(G) := generic_g2gg(G)$
00175 gl2gg(G) := generic_g2gg(G)$
00176 mug2gg(G) := generic_mug2gg(G)$
00177 mugl2gg(G) := generic_mug2gg(G)$
00178 
00179 ogl2omugl(G) := generic_g2mug(G)$
00180 og2ogg(G) := generic_g2gg(G)$
00181 ogl2ogg(G) := generic_g2gg(G)$
00182 omugl2ogg(G) := generic_omug2ogg(G)$
00183 
00184 g2og(G) := generic_g2og(G)$
00185 gl2ogl(G) := generic_g2og(G)$
00186 mug2omug(G) := generic_gg2ogg(G)$
00187 mugl2omugl(G) := generic_gg2ogg(G)$
00188 gg2ogg(G) := generic_gg2ogg(G)$
00189 
00190 dg2mudg(G) := generic_g2mug(G)$
00191 dgl2mudgl(G) := generic_g2mug(G)$
00192 dg2gdg(G) := generic_g2gg(G)$
00193 dgl2gdg(G) := generic_g2gg(G)$
00194 mudg2gdg(G) := generic_mug2gg(G)$
00195 mudgl2gdg(G) := generic_mug2gg(G)$
00196 
00197 odgl2omudgl(G) := generic_g2mug(G)$
00198 odg2ogdg(G) := generic_g2gg(G)$
00199 odgl2ogdg(G) := generic_g2gg(G)$
00200 omudgl2ogdg(G) := generic_omug2ogg(G)$
00201 
00202 dg2odg(G) := generic_g2og(G)$
00203 dgl2odgl(G) := generic_g2og(G)$
00204 mudg2omudg(G) := generic_gg2ogg(G)$
00205 mudgl2omudgl(G) := generic_gg2ogg(G)$
00206 gdg2ogdg(G) := generic_gg2ogg(G)$
00207 
00208 
00209 /* *************
00210    * Downcasts *
00211    *************
00212 */
00213 
00214 generic_gg2mugl(G) := [
00215  G[1], 
00216  map(G[3],G[2]),
00217  buildq([G],lambda([e],length(subset(G[2],lambda([x],is(G[3](x)=e))))))
00218 ]$
00219 generic_ogg2omugl(G) := [
00220  G[1], 
00221  stable_unique(map(G[3],G[2])),
00222  buildq([G],lambda([e],length(sublist(G[2],lambda([x],is(G[3](x)=e))))))
00223 ]$
00224 
00225 mug2g(G) := [G[1],G[2]]$
00226 mugl2gl(G) := [G[1],G[2]]$
00227 gg2gl(G) := [G[1], map(G[3],G[2])]$
00228 gg2mugl(G) := generic_gg2mugl(G)$
00229 
00230 omug2og(G) := [G[1],G[2]]$
00231 omugl2ogl(G) := [G[1],G[2]]$
00232 ogg2ogl(G) := [G[1], stable_unique(map(G[3],G[2]))]$
00233 ogg2omugl(G) := generic_ogg2omugl(G)$
00234 
00235 og2g(G) := [setify(G[1]), setify(G[2])]$
00236 ogl2gl(G) := [setify(G[1]), setify(G[2])]$
00237 omug2mug(G) := [setify(G[1]), setify(G[2]), G[3]]$
00238 omugl2mugl(G) := [setify(G[1]), setify(G[2]), G[3]]$
00239 ogg2gg(G) := [setify(G[1]), setify(G[2]), G[3]]$
00240 
00241 mudg2dg(G) := [first(G),second(G)]$
00242 mudgl2dgl(G) := [G[1],G[2]]$
00243 gdg2dgl(G) := [G[1], map(G[3],G[2])]$
00244 gdg2mudgl(G) := generic_gg2mugl(G)$
00245 
00246 omudg2odg(G) := [G[1],G[2]]$
00247 omudgl2odgl(G) := [G[1],G[2]]$
00248 ogdg2odgl(G) := [G[1], stable_unique(map(G[3],G[2]))]$
00249 ogdg2omudgl(G) := generic_ogg2omugl(G)$
00250 
00251 odg2dg(G) := [setify(G[1]), setify(G[2])]$
00252 odgl2dgl(G) := [setify(G[1]), setify(G[2])]$
00253 omudg2mudg(G) := [setify(G[1]), setify(G[2]), G[3]]$
00254 omudgl2mudgl(G) := [setify(G[1]), setify(G[2]), G[3]]$
00255 ogdg2gdg(G) := [setify(G[1]), setify(G[2]), G[3]]$
00256 
00257 
00258 /* ***************
00259    * Conversions *
00260    ***************
00261 */
00262 
00263 /* Removal of loops: */
00264 gl2g(G) := [G[1], subset(G[2],lambda([e],is(length(e)=2)))]$
00265 gg2g(G) := gl2g(gg2gl(G))$
00266 ogl2og(G) := [G[1], sublist(G[2],lambda([e],is(length(e)=2)))]$
00267 ogg2og(G) := ogl2og(ogg2ogl(G))$
00268 mugl2mug(G) := [G[1], subset(G[2],lambda([e],is(length(e)=2))), G[3]]$
00269 omugl2omug(G) := [G[1], sublist(G[2],lambda([e],is(length(e)=2))), G[3]]$
00270 dgl2dg(G) := [G[1], subset(G[2],lambda([e],is(first(e)#second(e))))]$
00271 odgl2odg(G) := [G[1], sublist(G[2],lambda([e],is(first(e)#second(e))))]$
00272 
00273 /* Underlying graphs of directed graphs: */
00274 dg2g(G) := [G[1], map(setify,G[2])]$
00275 odg2og(G) := [G[1], stable_unique(map(setify,G[2]))]$
00276 dgl2gl(G) := [G[1], map(setify,G[2])]$
00277 odgl2ogl(G) := [G[1], stable_unique(map(setify,G[2]))]$
00278 gdg2gg(G) := [G[1], G[2], buildq([G],lambda([e],setify(G[3](e))))]$
00279 ogdg2ogg(G) := [G[1], G[2], buildq([G],lambda([e],setify(G[3](e))))]$
00280 mudg2mug(G) := 
00281  endcons(buildq([E:G[2],ef:G[3]], 
00282      lambda([e], block([e1:listify(e), e2], e2 : reverse(e1),
00283        if elementp(e1,E) then ef(e1) + if elementp(e2,E) then ef(e2) else 0
00284        else ef(e2)))), 
00285      dg2g(mudg2dg(G)))$
00286 
00287 /* Representing graphs by directed graphs: */
00288 g2dg(G) := [G[1], setify(lappend(
00289   map(lambda([e], block([d : listify(e)], [d,reverse(d)])),
00290       listify(G[2]))))]$
00291 gl2dgl(G) := [G[1], setify(lappend(
00292   map(lambda([e], block([d : listify(e)], 
00293         if length(d)=1 then [append(d,d)] else [d,reverse(d)])),
00294       listify(G[2]))))]$
00295 mug2mudg(G) := block([DG : g2dg(mug2g(G))], 
00296  endcons(buildq([ef:G[3]], lambda([e], ef(setify(e)))), DG))$
00297 
00298 
00299 /* **************************
00300    * Basic graph operations *
00301    **************************
00302 */
00303 
00304 /* Auxiliary function, expanding an undirected edge into a directed
00305    edge, using the given Maxima-order: */
00306 expand_edge(ue) := block([de : listify(ue)],
00307   if length(de) = 2 then de else append(de,de))$
00308 
00309 /* The set of neighbours of vertex v in graph G. */
00310 /* RENAME to "neighbours_g". */
00311 neighbours(v,G) := disjoin(v, lunion(
00312  subset(G[2], lambda([e],elementp(v,e)))))$
00313 neighbours_g(v,G) := neighbours(v,G)$
00314 neighbours_og(v,G) := disjoin(v, lunion(
00315  sublist(G[2], lambda([e],elementp(v,e)))))$
00316 neighbours_gl(v,G) := lunion( 
00317  map(lambda([e], if e={v} then e else disjoin(v,e)),
00318      sublist(listify(G[2]), lambda([e],elementp(v,e)))))$
00319 neighbours_gg(v,G) := neighbours_gl(v,gg2gl(G))$
00320 
00321 outneighbours_dg(v,G) := outneighbours_dgl(v,G)$
00322 outneighbours_dgl(v,G) :=
00323  setify(map(second,sublist(listify(G[2]), lambda([e], is(e[1]=v)))))$
00324 inneighbours_dg(v,G) := inneighbours_dgl(v,G)$
00325 inneighbours_dgl(v,G) :=
00326  setify(map(first,sublist(listify(G[2]), lambda([e], is(e[2]=v)))))$
00327 
00328 
00329 /* Removes vertex set V from graph G (with loops). */
00330 /* RENAME: "remove_vertices_gl". */
00331 remove_vertices_graph(V,G) := [setdifference(G[1],V),
00332  subset(G[2], lambda([e], disjointp(e,V)))]$
00333 remove_vertices_gl(V,G) := remove_vertices_graph(V,G)$
00334 
00335 
00336 /* *****************************
00337    * Basic graph constructions *
00338    *****************************
00339 */
00340 
00341 /* The induced subgraph of a graph, given by an edge-set: */
00342 
00343 edge_induced_subgraph_g(E,G) := [lunion(E),E]$
00344 edge_induced_subgraph_gl(E,G) := edge_induced_subgraph_g(E,G)$
00345 edge_induced_subgraph_mug(E,G) := [lunion(subset(E,lambda([e],is(G[3](e) > 0)))),E,buildq([E,G3:G[3]], lambda([e],if elementp(e,E) then G3(e)))]$
00346 edge_induced_subgraph_mugl(E,G) := edge_induced_subgraph_mug(E,G)$
00347 edge_induced_subgraph_gg(E,G) := [lunion(map(G[3],E)),E,G[3]]$
00348 edge_induced_subgraph_dg(E,G) := [lunion(map(setify,E)),E]$
00349 edge_induced_subgraph_dgl(E,G) := edge_induced_subgraph_dg(E,G)$
00350 edge_induced_subgraph_mudg(E,G) := [lunion(map(setify,E)),E,buildq([E,G3:G[3]],lambda([e],if elementp(e,E) then G3(e)))]$
00351 edge_induced_subgraph_mudgl(E,G) := edge_induced_subgraph_mudg(E,G)$
00352 edge_induced_subgraph_gdg(E,G) := [lunion(map(setify,(map(G[3],E)))),E,buildq([E,G3:G[3]],lambda([e],if elementp(e,E) then G3(e)))]$
00353 
00354 /* The complement-graph of a graph: */
00355 /* RENAME to "complement_g". */
00356 comp_graph(G) := [G[1], setdifference(powerset(G[1],2),G[2])]$
00357 complement_g(G) := comp_graph(G)$
00358 
00359 /* The transposed of a directed graph: */
00360 transposed_dg(G) := [G[1], map(reverse,G[2])]$
00361 transposed_dgl(G) := [G[1], map(reverse,G[2])]$
00362 transposed_odg(G) := [G[1], map(reverse,G[2])]$
00363 transposed_odgl(G) := [G[1], map(reverse,G[2])]$
00364 
00365 
00366 /* **********
00367    * Tests  *
00368    **********
00369 */
00370 
00371 /* Tests whether a general or multi-graph has parallel edges: */
00372 parallel_edges_gg_p(G) := is(length(map(G[3],G[2])) < length(G[2]))$
00373 parallel_edges_mug_p(G) := some_s(lambda([e],is(G[3](e)>1)),G[2])$
00374 parallel_edges_mugl_p(G) := some_s(lambda([e],is(G[3](e)>1)),G[2])$
00375 parallel_edges_ogg_p(G) := is(length(setify(map(G[3],G[2]))) < length(G[2]))$
00376 parallel_edges_omug_p(G) := some_s(lambda([e],is(G[3](e)>1)),G[2])$
00377 parallel_edges_omugl_p(G) := some_s(lambda([e],is(G[3](e)>1)),G[2])$
00378 
00379 
00380 /* Tests whether a graph with loops is irreflexive (that is, doesn't actually
00381    have loops): */
00382 irreflexive_gl_p(G) := every_s(lambda([e],is(length(e)=2)), G[2])$
00383 irreflexive_mugl_p(G) := every_s(lambda([e],is(length(e)=2)),G[2])$
00384 irreflexive_gg_p(G) := every_s(lambda([e],is(length(G[3](e))=2)),G[2])$
00385 irreflexive_ogl_p(G) := every_s(lambda([e],is(length(e)=2)),G[2])$
00386 irreflexive_omugl_p(G) := every_s(lambda([e],is(length(e)=2)),G[2])$
00387 irreflexive_ogg_p(G) := every_s(lambda([e],is(length(G[3](e))=2)),G[2])$
00388 
00389 
00390 /* An "oriented graph" is, following the abuse of language in [Jensen,
00391    Gutin; Digraphs], a directed graph without antiparallel edges: */
00392 orientedgraph_dg_p(G) := not is(length(map(setify,G[2])) < length(G[2]))$
00393 orientedgraph_dgl_p(G) := not is(length(map(setify,G[2])) < length(G[2]))$
00394 orientedgraph_odg_p(G) := not is(length(setify(map(setify,G[2]))) < length(G[2]))$
00395 orientedgraph_odgl_p(G) := not is(length(setify(map(setify,G[2]))) < length(G[2]))$
00396 
00397 
00398 /* Tests whether a graph is complete: */
00399 complete_g_p(G) := is(binomial(length(G[1]),2) = length(G[2]))$
00400 complete_gl_p(G) := complete_g_p(gl2g(G))$
00401 complete_og_p(G) := is(binomial(length(G[1]),2) = length(G[2]))$
00402 complete_ogl_p(G) := complete_og_p(ogl2og(G))$
00403 complete_mug_p(G) := complete_g_p(mug2g(G))$
00404 complete_mugl_p(G) := complete_gl_p(mugl2gl(G))$
00405 complete_omug_p(G) := complete_og_p(omug2og(G))$
00406 complete_omugl_p(G) := complete_ogl_p(omugl2ogl(G))$
00407 complete_gg_p(G) := complete_gl_p(gg2gl(G))$
00408 complete_ogg_p(G) := complete_ogl_p(ogg2ogl(G))$
00409 
00410 /* Checks for dominating vertices in graphs with and without loops: */
00411 dominating_vertex_g_p(v,G) := 
00412   is(length(neighbours_g(v,G)) = length(G[1])-1)$
00413 dominating_vertex_gl_p(v,G) := 
00414   is(length(neighbours_gl(v,G)) = length(G[1]))$
00415 
00416 has_dominating_vertex_g(G) :=
00417   is(max_vertex_degree_v_og(g2og(G))[1] = length(G[1])-1)$
00418 /* Remark: has_dominating_vertex_g(G) =
00419   some_s(lambda([v],dominating_vertex_g_p(v,G)), G[1]).
00420 */
00421 has_dominating_vertex_gl(G) :=
00422   is(max_vertex_degree1_v_ogl(gl2ogl(G))[1] = length(G[1]))$
00423 /* Remark: has_dominating_vertex_gl(G) =
00424   some_s(lambda([v],dominating_vertex_gl_p(v,G)), G[1]).
00425 */
00426 
00427 
00428 /* Tests whether a graph is connected: */
00429 connected_g_p(G) := is_connected(g2mg(G))$
00430 connected_og_p(G) := is_connected(og2mg(G))$
00431 connected_mug_p(G) :=  connected_g_p(mug2g(G))$
00432 connected_omug_p(G) :=  connected_og_p(omug2og(G))$
00433 connected_gg_p(G) :=  connected_gl_p(gg2gl(G))$
00434 connected_ogg_p(G) :=  connected_ogl_p(ogg2ogl(G))$
00435 connected_gl_p(G) := is_connected(g2mg(gl2g(G)))$
00436 connected_ogl_p(G) := is_connected(og2mg(ogl2og(G)))$
00437 connected_mugl_p(G) :=  connected_gl_p(mugl2gl(G))$
00438 connected_omugl_p(G) :=  connected_ogl_p(omugl2ogl(G))$
00439 
00440 /* Tests whether a digraph is strongly connected: */
00441 sconnected_dg_p(G) := emptyp(G[1]) or is_sconnected(dg2mdg(G))$
00442 sconnected_odg_p(G) := emptyp(G[1]) or is_sconnected(odg2mdg(G))$
00443 sconnected_mudg_p(G) := sconnected_dg_p(mudg2dg(G))$
00444 sconnected_omudg_p(G) := sconnected_odg_p(omudg2odg(G))$
00445 sconnected_gdg_p(G) := sconnected_dgl_p(gdg2dgl(G))$
00446 sconnected_ogdg_p(G) := sconnected_odgl_p(ogdg2odgl(G))$
00447 sconnected_dgl_p(G) := sconnected_dg_p(dgl2dg(G))$
00448 sconnected_odgl_p(G) := sconnected_odg_p(odgl2odg(G))$
00449 sconnected_mudgl_p(G) := sconnected_dgl_p(mudgl2dgl(G))$
00450 sconnected_omudgl_p(G) := sconnected_odgl_p(omudgl2odgl(G))$
00451 
00452 
00453 /* Tests whether a graph is a tree: */
00454 tree_g_p(G) := is_tree(g2mg(G))$
00455 tree_og_p(G) := is_tree(og2mg(G))$
00456 tree_mug_p(G) :=  not parallel_edges_mug_p(G) and tree_g_p(mug2g(G))$
00457 tree_omug_p(G) :=  not parallel_edges_omug_p(G) and tree_og_p(omug2og(G))$
00458 tree_gg_p(G) :=  not parallel_edges_gg_p(G) and tree_gl_p(gg2gl(G))$
00459 tree_ogg_p(G) :=  not parallel_edges_ogg_p(G) and tree_ogl_p(ogg2ogl(G))$
00460 tree_gl_p(G) := irreflexive_gl_p(G) and tree_g_p(G)$
00461 tree_ogl_p(G) := irreflexive_ogl_p(G) and tree_og_p(G)$
00462 tree_mugl_p(G) :=  irreflexive_mugl_p(G) and tree_mug_p(G)$
00463 tree_omugl_p(G) :=  irreflexive_omugl_p(G) and tree_omug_p(G)$
00464 
00465 
00466 /* Tests whether a graph is regular: */
00467 regular_g_p(k,G) := block([h : hm2osm(vertex_degrees_g(G))],
00468   every_s(lambda([p],is(second(p) = k)),h))$
00469 /* Counting loops once in a general graph: */
00470 regular1_gg_p(k,G) := block([h : hm2osm(vertex_degrees1_gg(G))],
00471   every_s(lambda([p],is(second(p) = k)),h))$
00472 /* Counting loops twice in a general graph: */
00473 regular2_gg_p(k,G) := block([h : hm2osm(vertex_degrees2_gg(G))],
00474   every_s(lambda([p],is(second(p) = k)),h))$
00475 
00476 
00477 /* Tests whether a graph is a cycle graph: */
00478 cycle_gg_p(G) := not emptyp(G[1]) and connected_gg_p(G) and regular2_gg_p(2,G)$
00479 
00480 /* Tests whether a graph is bipartite: */
00481 bipartite_g_p(G) := is_bipartite(g2mg(G))$
00482 
00483 /* Tests whether a graph is complete bipartite: */
00484 completebipartite_g_p(G) := if emptyp(G[1]) then true
00485  else connected_g_p(G) and block([B : bipartition(g2mg(G))],
00486    not emptyp(B) and is(length(B[1]) * length(B[2]) = length(G[2])))$
00487 /* Remark: A graph is complete bipartite iff adding any edge either destroys
00488    the graph property of destroys bipartiteness. */
00489 completebipartite_gl_p(G) := irreflexive_gl_p(G) and completebipartite_g_p(G)$
00490 completebipartite_gg_p(G) := completebipartite_gl_p(gg2gl(G))$
00491 
00492 
00493 /* ********************************
00494    * Connections to Maxima-graphs *
00495    ********************************
00496 */
00497 
00498 /* Graphs to Maxima-graphs (vertex names yield vertex labels).
00499    The vertices in the Maxima-graph are numbered starting with 1.
00500    Edges in the Maxima-graph are ordered in an implementation-defined way,
00501    while the vertex-order is preserved.
00502 */
00503 og2mg(G) := block(
00504  [V : G[1], E : G[2], h],
00505   h : osm2hm(l2osm_inv(V)),
00506   create_graph(l2osm(V),
00507     create_list([ev_hm(h,listify(e)[1]), ev_hm(h,listify(e)[2])], e, E)
00508   )
00509 )$
00510 g2mg(G) := og2mg(gl2ogl(G))$
00511 /* Without the vertex-labels: */
00512 og2mg_nl(G) := block(
00513  [V : G[1], E : G[2], h, n : length(G[1])],
00514  h : osm2hm(l2osm_inv(V)),
00515  create_graph(create_list(i,i,1,n), 
00516    create_list([ev_hm(h,listify(e)[1]), ev_hm(h,listify(e)[2])], e, E)
00517  )
00518 )$
00519 g2mg_nl(G) := og2mg_nl(gl2ogl(G))$
00520 
00521 /* Maxima-graphs to ordered graphs, moving 0-based indices to 1-based
00522    (ignoring the vertex labels). */
00523 mg2og(g) := block([V : vertices(g), E : edges(g)],
00524   if elementp_l(0,V) then (V:V+1, E:E+1),
00525   return([V,map(setify,E)]))$
00526 /* Maxima-graphs to graphs (ignoring the vertex labels): */
00527 mg2g(g) := block([G : mg2og(g)], [setify(G[1]), setify(G[2])])$
00528 
00529 
00530 /* Digraphs to Maxima-digraphs (vertex names yield vertex labels).
00531    The vertices in the Maxima-digraph are numbered starting with 1. */
00532 dg2mdg(G) := block(
00533  [V : listify(G[1]), E : listify(G[2]), h : sm2hm({}), n : length(G[1])],
00534  for i : 1 thru n do set_hm(h, V[i], i),
00535  return(
00536    create_graph(
00537      create_list([i,V[i]],i,1,n), 
00538      create_list([ev_hm(h,e[1]), ev_hm(h,e[2])], e, E),
00539      true
00540  ))
00541 )$
00542 
00543 odg2mdg(G) := block(
00544  [V : G[1], E : G[2], h : sm2hm({}), n : length(G[1])],
00545  for i : 1 thru n do set_hm(h, V[i], i),
00546  return(
00547    create_graph(
00548      create_list([i,V[i]],i,1,n), 
00549      create_list([ev_hm(h,e[1]), ev_hm(h,e[2])], e, E),
00550      true
00551  ))
00552 )$
00553 
00554