share/graphs/create_graph.mac

   1 /*
   2
   3   GRAPHS - graph theory package for Maxima
   4   Copyright (C) 2007-2011 Andrej Vodopivec <andrej.vodopivec@gmail.com>
   5
   6   This program is free software; you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation; either version 2 of the License, or
   9   (at your option) any later version.
  10
  11   This program is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with this program; if not, write to the Free Software
  18   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  19
  20 */
  21
  22 as_directed_graph(g) := block(
  23   [edges, dedges],
  24   if is_digraph(g) then return(g),
  25   if not is_graph(g) then error("as_directed_graph: the argument is no a graph!", g),
  26   edges: edges(g),
  27   dedges: append(edges, map(reverse, edges)),
  28   create_graph(vertices(g), dedges, 'directed=true))$
  29
  30 relabel_graph_vertices(gr, [options]) := block(
  31   [min_id: assoc('min_id, options, 0),
  32   new_ids: hash_table(), vrt:[], edg:[]],
  33   for v in vertices(gr) do (
  34     set_hash(v, new_ids, min_id),
  35     vrt: cons(min_id, vrt),
  36     min_id: min_id+1),
  37   for e in edges(gr) do
  38   edg: cons([get_hash(e[1], new_ids), get_hash(e[2], new_ids)], edg),
  39   create_graph(vrt, edg, directed=is_digraph(gr)))$
  40
  41 subdivide_edge(e, g, [n]) := block(
  42   [pos: get_positions(g), added_vertices],
  43   if length(n)=1 then n: first(n) else n:1,
  44   remove_edge(e, g),
  45   added_vertices: add_vertices(n, g),
  46   add_edges(
  47     append(
  48       [[e[1], first(added_vertices)]],
  49       makelist([added_vertices[i], added_vertices[i+1]], i, 1, n-1),
  50       [[last(added_vertices), e[2]]]),
  51     g),
  52   if pos#false then
  53     pos: append(
  54       makelist([added_vertices[i], (i*assoc(e[1], pos)+(n+1-i)*assoc(e[2],pos))/(n+1)], i, 1, n),
  55       pos),
  56   set_positions(pos, g),
  57   'done)$
  58
  59 subdivide_edges(e_lst, g, [n]) :=
  60   block([n: if length(n)=1 then first(n) else 1],
  61     for e in e_lst do subdivide_edge(e, g, n))$
  62
  63 random_network(n, p, w) := block(
  64   [net, source, sink, u, v],
  65   net: empty_digraph(n),
  66   source: n,
  67   sink: n+1,
  68   add_vertex(source, net),
  69   add_vertex(sink, net),
  70   for i:0 thru n-1 do (
  71     for j:0 thru n-1 do(
  72       if i#j then (
  73         if random(1.0)<p then (
  74           add_edge([i, j], net),
  75           set_edge_weight([i, j], random(w), net)) ))),
  76   for i:0 thru n-1 do (
  77     if random(1.0)<p then (
  78       add_edge([i, n+1], net),
  79       set_edge_weight([i, n+1], random(w), net)),
  80     if random(1.0)<p then (
  81       add_edge([n, i], net),
  82       set_edge_weight([n, i], random(w), net))),
  83   [net, source, sink])$
  84
  85 random_regular_graph(n, [d]) := block(
  86   [m, D, edg, i, j, e, i0],
  87   if length(d)=1 then d: d[1]
  88   else d: 3,
  89   m: d*n,
  90   if mod(m,2)#0 then (
  91     m: m+d,
  92     n: n+1),
  93   U: 1,
  94   while U=1 do (
  95     U: makelist(i0-1,i0,1,m),
  96     edg: [],
  97     while length(U)#0 do (
  98       i: U[random(length(U))+1],
  99       U: delete(i, U),
 100       j: U[random(length(U))+1],
 101       U: delete(j, U),
 102       i: divide(i, d)[1],
 103       j: divide(j, d)[1],
 104       e: [min(i,j), max(i,j)],
 105       if i=j or member(e, edg) then U=[]
 106       else edg: cons(e, edg)),
 107     if 2*length(edg)<d*n then U: 1
 108     else U: 0),
 109   create_graph(makelist(i0-1,i0,1,n), edg))$
 110
 111 mycielski_graph(g) := block(
 112   [mapping:hash_table(), ng, i:0, edges:[], vertices],
 113   if not is_graph(g) then error("`mycielsky_graph': argument is not a graph"),
 114   for v in vertices(g) do (
 115     set_hash(v, mapping, i),
 116     i : i+1),
 117   vertices : makelist(i, i, 0, 2*i),
 118   for e in edges(g) do (
 119     edges : cons([get_hash(e[1], mapping), get_hash(e[2], mapping)], edges),
 120     edges : cons([get_hash(e[1], mapping)+i, get_hash(e[2], mapping)], edges),
 121     edges : cons([get_hash(e[1], mapping), get_hash(e[2], mapping)+i], edges)),
 122   for j:0 thru i-1 do edges : cons([i+j, 2*i], edges),
 123   create_graph(vertices, edges))$
 124
 125 grotzch_graph() := block(
 126   [g:mycielski_graph(cycle_graph(5)), positions:[]],
 127   for i:0 thru 4 do (
 128     positions : cons([i, [sin(2.0*i*%pi/5), cos(2.0*i*%pi/5)]], positions),
 129     positions : cons([i+5, [0.5*sin(2.0*i*%pi/5), 0.5*cos(2.0*i*%pi/5)]],
 130       positions)),
 131   positions : cons([10, [0,0]], positions),
 132   set_positions(positions, g),
 133   g)$
 134
 135 complete_bipartite_graph(n, m) := block(
 136   [edges, A, B, g],
 137   if not (integerp(n) and integerp(m)) or
 138        n<=0 or m<=0 then
 139      error("`complete_bipartite_graph': arguments are not positive integers"),
 140   A : makelist(i-1, i, 1, n),
 141   B : makelist(i+n-1, i, 1, m),
 142   edges : create_list([i,j], i, A, j, B),
 143   g : create_graph(append(A, B), edges),
 144   set_positions(
 145     append(
 146       makelist([i-1, [0, i-n/2]], i, 1, n),
 147       makelist([i+n-1, [1, i-m/2]], i, 1, m)),
 148     g),
 149   g)$
 150
 151 grid_graph(n, m) :=
 152   if not (integerp(n) and integerp(m)) or
 153        n<=0 or m<=0 then
 154      error("`grid_graph': arguments are not positive integers")
 155   else block(
 156     [g:graph_product(path_graph(n), path_graph(m)), numer:true, pos:[]],
 157     for i:0 thru n-1 do
 158       for j:0 thru m-1 do
 159         pos:cons([n*j+i, [i/n, j/m]], pos),
 160     set_positions(pos, g),
 161     g)$
 162
 163 grid_graph1(n,m) := block(
 164   [g, pos],
 165   g:make_graph(
 166     makelist(i-1,i,n*m),
 167     lambda([a, b],
 168       block([ax,ay,bx,by],
 169         [ax,ay]:divide(a,n),
 170         [bx,by]:divide(b,n),
 171         is( abs(ax-bx)<=1 and abs(ay-by)<=1)))),
 172   set_positions(makelist([i-1, divide(i-1, n)], i, n*m), g),
 173   g);
 174
 175 tetrahedron_graph() := complete_graph(4)$
 176
 177 bipiramid_graph(n) := block(
 178   [g: cycle_graph(n)],
 179   add_vertices([n,n+1], g),
 180   pos: makelist([i, [3*cos(2*%pi*i/n), sin(2*%pi*i/n)]], i, 0, n-1),
 181   pos: append([[n, [0,5]], [n+1, [0,-5]]], pos),
 182   connect_vertices([n,n+1],makelist(i,i,0,n-1),g),
 183   set_positions(pos, g),
 184   g)$
 185
 186 cube_graph(n) :=
 187   if n<0 then error("cub_graph(n): n can't be negative!")
 188   else if n=0 then empty_graph(1)
 189   else if n=1 then path_graph(2)
 190   else block(
 191     [k,r,g],
 192     [k,r]:divide(n, 2),
 193     g:graph_product(cube_graph(k), cube_graph(k)),
 194     if r=1 then g:graph_product(g, path_graph(2)),
 195     g)$
 196
 197 octahedron_graph() := create_graph(
 198   6,
 199   [[3,5],[2,5],[1,5],[0,5],[3,4],[2,4],[1,4],[0,4],
 200    [0,3],[2,3],[1,2],[0,1]])$
 201
 202 icosahedron_graph() := create_graph(
 203   12,
 204   [
 205    [0,1],[1,2],[2,3],[3,4],[0,4],
 206    [5,6],[6,7],[7,8],[8,9],[5,9],
 207    [0,5],[5,1],[1,6],[6,2],[2,7],
 208    [7,3],[3,8],[8,4],[4,9],[0,9],
 209    [0,10],[1,10],[2,10],[3,10],[4,10],
 210    [5,11],[6,11],[7,11],[8,11], [9,11]
 211   ])$
 212
 213 dodecahedron_graph() := create_graph(
 214   20,
 215   [
 216    [0,1],[1,2],[2,3],[3,4],[0,4],[0,15],[1,19],
 217    [2,18],[3,17],[4,16],[10,15],[10,16],[11,16],
 218    [11,17],[12,17],[12,18],[13,18],[13,19],[14,15],
 219    [14,19],[6,10],[8,11],[9,12],[7,13],[5,14],[5,6],
 220    [6,8],[8,9],[7,9],[5,7]
 221   ])$
 222
 223 heawood_graph() := block(
 224   [g],
 225   g:create_graph(
 226     14,
 227     [
 228      [0,1],[1,2],[2,3],[3,4],[4,5],[5,6],[6,7],[7,8],
 229      [8,9],[9,10],[10,11],[11,12],[12,13],[0,13],
 230      [0,9],[1,6],[2,11],[3,8],[4,13],[5,10],[7,12]
 231     ]),
 232   set_positions(circular_positions(g), g),
 233   g)$
 234
 235 frucht_graph() := create_graph(
 236   12,
 237   [
 238    [0,1],[1,2],[2,3],
 239    [3,4],[4,5],[5,6],
 240    [0,6],[0,7],[7,1],
 241    [2,8],[8,3],[4,9],
 242    [9,5],[6,10],[10,9],
 243    [11,10],[11,7],[11,8]
 244   ]);
 245
 246 clebsch_graph() := block(
 247   [g, positions : []],
 248   g : create_graph(
 249     16,
 250     [
 251      [0,1],[1,2],[2,3],[3,4],[0,4],
 252      [0,10],[1,11],[2,12],[3,13],[4,14],
 253      [0,6],[1,7],[2,8],[3,9],[4,5],
 254      [0,8],[1,9],[2,5],[3,6],[4,7],
 255      [5,11],[6,12],[7,13],[8,14],[9,10],
 256      [5,10],[6,11],[7,12],[8,13],[9,14],
 257      [5,15],[6,15],[7,15],[8,15],[9,15],
 258      [10,12],[11,13],[12,14],[13,10],[14,11]
 259     ]
 260     ),
 261   for i:0 thru 4 do (
 262     positions : cons([i, [sin(2*i*%pi/5.0), cos(2*i*%pi/5.0)]], positions),
 263     positions : cons([i+5,
 264       [0.7*sin(2*i*%pi/5.0+%pi/5.0), 0.7*cos(2*i*%pi/5+%pi/5.0)]],
 265       positions),
 266     positions : cons([i+10,
 267       [0.3*sin(2*i*%pi/5.0), 0.3*cos(2*i*%pi/5)]],
 268       positions)),
 269   positions : cons([15, [0,0]], positions),
 270   set_positions(positions, g),
 271   g)$
 272
 273 induced_subgraph1(e_list, gr) := block(
 274   [v_list : setify(xreduce(append, e_list))],
 275   create_graph(listify(v_list), e_list))$
 276
 277 make_graph(vertices, edges_lambda, [dir]) := block(
 278   [%n%, v_map, edges:[], j_min, int_vertices, vrt, e_list, directed: assoc('directed, dir, false)],
 279
 280   /* Build a list of vertices */
 281   if integerp(vertices) then (
 282     %n% : vertices,
 283     vrt : makelist(i, i, 1, %n%),
 284     v_map : makelist(i=i, i, 1, %n%))
 285   else (
 286     %n% : length(vertices),
 287     vrt : %n%,
 288     v_map : makelist(i=part(vertices, i), i, 1, %n%)),
 289
 290   /* Build a list of edges */
 291   if listp(edges_lambda) then block(
 292     [inv_map:map(reverse, v_map)],
 293     edges : map(lambda([e], [assoc(e[1], inv_map), assoc(e[2], inv_map)]), edges_lambda))
 294   else (
 295     for i:1 thru %n% do (
 296       if directed=true then
 297         for j:1 thru i-1 do
 298           if apply(edges_lambda, [assoc(i, v_map), assoc(j, v_map)])=true then
 299             edges : cons([i,j], edges),
 300       for j:i+1 thru %n% do
 301         if apply(edges_lambda, [assoc(i, v_map), assoc(j, v_map)])=true then
 302           edges : cons([i,j], edges))),
 303
 304   /* Put the labels on vertices if vertices is not a list of integers */
 305   if not(integerp(vertices)) then (
 306     if every(integerp, vertices) then (
 307       vrt : vertices,
 308       edges : map( lambda([u], [assoc(u[1], v_map), assoc(u[2], v_map)]), edges))
 309     else (
 310       vrt : makelist([i, part(vertices, i)], i, 1, %n%))),
 311
 312   /* Create the graph */
 313   if directed=true then
 314     create_graph(vrt, edges, 'directed=true)
 315   else
 316     create_graph(vrt, edges))$
 317
 318 tutte_graph() := sparse6_decode(
 319   ":m`?WSMHDbPwGa@?_QhSs\\NgRaKE`HEdH@QaUbca|MUX`qr[YW\\eVwaAs[nF{UMqclhIYYCfSWCmDT\\QpTYr")$
 320
 321 cycle_positions(cycles) := block(
 322   [pos:[],r:1,i,v,pi:float(%pi),po,k],
 323   po: apply(lcm, map(length, cycles)),
 324   if length(first(cycles))=1 then (
 325     pos: cons([part(cycles, 1, 1), [0,0]], pos),
 326     cycles: rest(cycles)),
 327   for c in cycles do (
 328     r: r+1, n: length(c),
 329     i:0, k: 2*pi*po/n,
 330     for v in c do (
 331       pos: cons([v, r*[cos(i*k/po), sin(i*k/po)]], pos),
 332       i:i+1)),
 333   pos)$
 334
 335 pappus_graph() := block(
 336   [g: graph6_decode("QhEKA?_C?O?_?P?g?I?@S?DOAG_")],
 337   set_positions(
 338     cycle_positions(reverse([[0,1,2,3,4,5],[6,7,8,9,10,11],[12,13,14,15,16,17]])),
 339     g),
 340   g)$
 341
 342 truncated_cube_graph() := graph6_decode("W`CaSG??G??@?@?A?AO@A?CG?_O?K??Q@A?G_O@?o?CC_?G")$
 343
 344 truncated_dodecahedron_graph() := sparse6_decode(":{b?GSkRI_owcUgNgSYPQeTcqi`]iWgeyHozGKqBP}?E_cgO]ERa@`{SMO_OPkIEMryLInSkjGYQIkbVssbAOkVQRKgtJEr@u\\UssjUkOUuabE~")$
 345
 346 truncated_icosahedron_graph() := sparse6_decode(":{a_gwMQ?AqoG]HEEQX\\C`Ogt`@ISRJRHky^]AdGxUg[ifJDdDapxKiY?Q_cwPaEXoWTdxP^Srcai]dTubiYu\\Rq@Pu_kVSTi}GEMO_`QEEIo@@iAIL~")$
 347
 348 truncated_octahedron_graph() := sparse6_decode(":W___``aBabcFdGcDefghLiMjkLkMnPoPqRsTU")$
 349
 350 truncated_tetrahedron_graph() := sparse6_decode(":KcAKhcgUs@PEa@wfT")$
 351
 352 cuboctahedron_graph() := sparse6_decode(":K`A?WAaIXGdcUXbsKayCi")$
 353
 354 icosidodecahedron_graph() := sparse6_decode(":]c?`cdEabjAIbIJeF_CG`DHaBGH_`iPiQRgLMhLNTwPRVqSV_AJP`BKQcEVWdFVX")$
 355
 356 great_rhombicosidodecahedron_graph() := sparse6_decode(":~?@w`?A@__QB@WcG_GELBGIB`GUECG[PaGcSagmKbPaMbx?UcP]QEhKZhAA`giM?_WIBaGeIIGkhbaiNIwqLhAadIYWihqm_gRaaMIKxMiomjQ}oKjCrgBQ`LYGuOIKvOYqlPJIrPiO{PIS|PYW}Pi[~P|@Kr[zNtTRStTZOsTbQstiSRDaTRTeURH\\LecyZRx`MUhdNU}`cx]Xgxue[VeQ\\VuU]WEY^WU^OXLDdseZRX|Pg[LTh[\\Xi[l\\j[~")$
 357
 358 small_rhombicosidodecahedron_graph() := sparse6_decode(":{`?GKSHFBOGKIF?COPKGSK`apkQIObPqTWGGaaWoiMJjTzDegYiertOw]ifRyAGDLEw@OkY_dQxmCSKFGXSq\\b@r`uOOccXPIURsY\\UnXlWZeE|aqgCTauWgURTIu[iVRtY}cRVJ}BHivwkurb")$
 359
 360 great_rhombicuboctahedron_graph() := sparse6_decode(":oa?wSE@?_og[OVDDP`K[PIdqACcbLeDH{wlA`oBCCrDaFG{W|XkUsDhB]PvsQQw`mgCtE`RSSdLXVVTJIaeigV^")$
 361
 362 small_rhombicuboctahedron_graph() := sparse6_decode(":Wa?`_`CabE_`aGbHcGdHKeIfJM_C`DOaEObFPQgKhLSiMSjNTU")$
 363
 364 snub_dodecahedron_graph() := sparse6_decode(":{a??SCFG??_cCEDbPwSMGEa`xCe@@jDIk?OOHOPHCf?HOQ[GGEEBgWSMLFsBDCr^nScDLBQLGCTKu`Pra`i]TLtAphGeidrYTNAEOpkWSMIHgwk]TRtAqmiVTP`S[UodbEBESLWKXWpSnXQ`il[rgDtQ}aUTjjqDCbngCQLpOJfcJYaUNgE~")$
 365
 366 snub_cube_graph() := sparse6_decode(":Wa?@_@eCDcDab_`eIfJcGdH_AGIK`BHJL`AGJM_BHINcEGKMdFHLNdEIKNcFJLM")$
 367
 368 chvatal_graph() := graph6_decode("KlDGiCh_hOoh")$
 369
 370 coxeter_graph() := sparse6_decode(":[___``aabbcdcdfJeIhLgKfehQgRlRkQUjTiSWnOmPY")$
 371
 372 desargues_graph() := sparse6_decode(":S___``aabbcFdEcHdGfHeGiJkLmNoPQ")$
 373
 374 tutte_cage_graph() := sparse6_decode(":]_`abcdefg`HidJklaMfNojPqbRgSlT_UpVcWhXmYrZ_E[")$
 375
 376 knight_tour_graph(a,[b]) := block(
 377   [g, pos:[]],
 378   if length(b)=1 then b:b[1] else b:a,
 379   g: make_graph(
 380     listify(cartesian_product(setify(makelist(i,i,1,a)), setify(makelist(i,i,1,b)))),
 381     lambda([u,v],
 382       is ( abs(u[1]-v[1])=1 and abs(u[2]-v[2])=2 ) or
 383       is ( abs(u[1]-v[1])=2 and abs(u[2]-v[2])=1 ))),
 384   for v in vertices(g) do
 385   pos: cons([v, divide(v-1, b)], pos),
 386   set_positions(pos, g),
 387   g)$
 388
 389 bull_graph() := create_graph(
 390   [1,2,3,4,5],
 391   [[1,2],[2,3],[3,1],[1,4],[2,5]])$
 392
 393 kite_graph() := create_graph(
 394   [1,2,3,4,5],
 395   [[1,2],[2,3],[3,4],[4,1],[2,4],[3,5]])$
 396
 397 star_graph(n) := if n=1 then empty_graph(1) else complete_bipartite_graph(1, n-1)$
 398
 399 book_graph(n) := graph_product(star_graph(n+1), path_graph(2))$
 400
 401 antiprism_graph(n) := block(
 402   [g:circulant_graph(2*n, [1, 2])],
 403   block([numer:true],
 404     set_positions(
 405       append(
 406         makelist([2*i-2, 2*[cos(2*i*%pi/n), sin(2*i*%pi/n)]], i, 1, n),
 407         makelist([2*i-1, [cos(2*i*%pi/n+%pi/n), sin(2*i*%pi/n+%pi/n)]], i, 1, n)),
 408       g)),
 409   g)$
 410
 411 gear_graph(n) := block(
 412   [g:cycle_graph(2*n)],
 413   add_vertex(2*n, g),
 414   connect_vertices([2*n], makelist(2*i,i,0,n-1),g),
 415   block([numer:true],
 416     set_positions(
 417       append(
 418         [[2*n, [0,0]]],
 419         makelist([i, [sin(i*%pi/n), cos(i*%pi/n)]], i, 0, 2*n, 2),
 420         makelist([i+1, 1.5*[sin((i+1)*%pi/n), cos((i+1)*%pi/n)]], i, 0, 2*n, 2)),
 421       g)),
 422   g)$
 423
 424 mobius_graph(n) := circulant_graph(2*n, [1,n])$
 425
 426 sunlet_graph(n) := block(
 427   [g: empty_graph(2*n)],
 428   add_edges(makelist([i, i+n], i, 0, n-1), g),
 429   add_cycle(makelist(i,i,0,n-1), g),
 430   block([numer:true],
 431     set_positions(
 432       append(
 433         makelist([i, [sin(2*i*%pi/n), cos(2*i*%pi/n)]], i, 0, n-1),
 434         makelist([i+n, 1.5*[sin(2*i*%pi/n), cos(2*i*%pi/n)]], i, 0, n-1)),
 435       g)),
 436   g)$
 437
 438 cone_graph(n, m) := graph_join(cycle_graph(n), empty_graph(m))$
 439
 440 fork_graph() := graph6_decode("DbC")$
 441
 442 centipede_graph(n) := block([edg1, edg2],
 443   edg1: makelist([i, i+n], i, 0, n-1),
 444   edg2: makelist([i,i+1], i, 0, n-2),
 445   create_graph(2*n, append(edg1, edg2)))$
 446
 447 hanoi_graph(n) :=
 448   if not integerp(n) or n<1 then funmake(hanoi_graph, [n])
 449   elseif n=1 then block(
 450     [hg: cycle_graph(3), pos, numer:true],
 451     pos: makelist([i, [cos(%pi/2+2*%pi/3*i), sin(%pi/2+2*%pi/3*i)]], i, 0, 2),
 452     set_positions(pos, hg),
 453     hg)
 454   else block(
 455     [hg1: hanoi_graph(n-1), hg, pos1, pos2, pos3, numer:true, a:2.2],
 456     hg: graph_union(hg1, hg1, hg1),
 457     add_edges([[(3^(n-1)-1)/2, 3^(n-1)],
 458       [3^(n-1)-1, 2*3^(n-1)],
 459       [2*3^(n-1)-1, (3^(n-1)-1)/2+2*3^(n-1)]], hg),
 460     pos1: get_positions(hg1),
 461     pos2: map(lambda([p], [3^(n-1)+p[1], a^(n-1)*[cos(%pi/2+2*%pi/3), sin(%pi/2+2*%pi/3)]+p[2]]), pos1),
 462     pos3: map(lambda([p], [2*3^(n-1)+p[1], a^(n-1)*[cos(%pi/2+4*%pi/3), sin(%pi/2+4*%pi/3)]+p[2]]), pos1),
 463     pos1: map(lambda([p], [p[1], a^(n-1)*[cos(%pi/2), sin(%pi/2)]+p[2]]), pos1),
 464     set_positions(append(pos1, pos2, pos3), hg),
 465     hg)$
 466
 467 franklin_graph() := block(
 468   [g: cycle_graph(12)],
 469   add_edges(
 470     [[6,11], [3,10],[0,9],[5,8],[2,7],[1,4]],
 471     g),
 472   g)$
 473
 474 crossed_prism_graph(n) := block(
 475   [g, pi:float(%pi)],
 476   if oddp(n) or n<4 then error("crossed_prism_graph: n should be even and at least 4"),
 477   g: graph_union(cycle_graph(n), cycle_graph(n)),
 478   add_edges(makelist([k,k+n+1], k, 0, n-2, 2), g),
 479   add_edges(makelist([k+1, k+n], k, 0, n-2, 2), g),
 480   set_positions(
 481     append(
 482       makelist([k, 3*[cos(k*2*pi/n), sin(k*2*pi/n)]], k, 0, n-1),
 483       makelist([n+k, 5*[cos(k*2*pi/n), sin(k*2*pi/n)]], k, 0, n-1)),
 484     g),
 485   g)$
 486
 487 flower_snark(n) := block(
 488   [fs: empty_graph(4*n), pi:float(%pi)],
 489   add_edges(
 490     append(
 491       makelist([i,i+1], i, 0, n-2),
 492       makelist([i,i+n], i, 0, n-1),
 493       makelist([i+n, i+2*n], i, 0, n-1),
 494       makelist([i+n, i+3*n], i, 0, n-1),
 495       makelist([i+2*n, i+3*n+1], i, 0, n-2),
 496       makelist([i+3*n, i+2*n+1], i, 0, n-2),
 497       [[0,n-1],[3*n, 3*n-1], [2*n,4*n-1]]),
 498     fs),
 499   set_positions(
 500     append(
 501       makelist([k, 2*[cos(2*k*pi/n), sin(2*k*pi/n)]], k, 0, n-1),
 502       makelist([k+n, 4*[cos(2*k*pi/n), sin(2*k*pi/n)]], k, 0, n-1),
 503       makelist([k+2*n, 7*[cos(2*k*pi/n-pi/2/n), sin(2*k*pi/n-pi/2/n)]], k, 0, n-1),
 504       makelist([k+3*n, 7*[cos(2*k*pi/n+pi/2/n), sin(2*k*pi/n+pi/2/n)]], k, 0, n-1)),
 505     fs),
 506   fs)$
 507
 508 complete_kpartite_graph([args]) := block(
 509   [graphs: map(complete_graph, args), g, pos, pi:float(%pi)],
 510   g: xreduce(graph_union, graphs),
 511   n: xreduce("+", args),
 512   g: complement_graph(g),
 513   pos: makelist([i, [cos(2*i/n*pi), sin(2*i/n*pi)]], i, 0, n-1),
 514   set_positions(pos, g),
 515   g)$
 516
 517 kneser_graph(n,k) := make_graph(powerset(setify(makelist(i,i,n)), k), disjointp)$
 518
 519 odd_graph(n) := kneser_graph(2*n-1, n-1)$
 520
 521 add_path(lst, g) :=
 522   add_edges(vertices_to_path(lst), g)$
 523
 524 add_cycle(lst, g) :=
 525   add_edges(vertices_to_cycle(lst), g)$