share/graphs/draw_graph.mac

   1 /*
   2   GRAPHS - graph theory package for Maxima
   3   Copyright (C) 2007-2011 Andrej Vodopivec <andrej.vodopivec@gmail.com>
   4
   5   This program is free software; you can redistribute it and/or modify
   6   it under the terms of the GNU General Public License as published by
   7   the Free Software Foundation; either version 2 of the License, or
   8   (at your option) any later version.
   9
  10   This program is distributed in the hope that it will be useful,
  11   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13   GNU General Public License for more details.
  14
  15   You should have received a copy of the GNU General Public License
  16   along with this program; if not, write to the Free Software
  17   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  18
  19 */
  20
  21 define_variable(gp_file_out, "out.txt", any)$
  22 define_variable(gp_file_in, "in.txt", any)$
  23 define_variable(draw_graph_program, 'spring_embedding, any)$
  24 define_variable(draw_graph_terminal, 'screen, any)$
  25 define_variable(graphs_plot_size, [400,400], list)$
  26
  27 if draw_loaded#true then load("draw")$
  28
  29 circular_positions(G) := block(
  30   [v_list, numer : true, n : graph_order(G)],
  31   v_list : vertices(G),
  32   makelist(
  33     [v_list[i+1],
  34     [2+cos(2*i*%pi/n), 2+sin(2*i*%pi/n)]],
  35     i, 0, graph_order(G)-1))$
  36
  37 write_file(G) := block(
  38   [display2d:false, file, e],
  39   file : openw(gp_file_in),
  40   printf(file, "graph {"),
  41   for e in edges(G) do (
  42     printf(file, "~s -- ~s~%", e[1], e[2])),
  43   printf(file, "}"),
  44   close(file),
  45   'done)$
  46
  47 read_file() := block(
  48   [lst : read_list(gp_file_out),
  49    v_pos : [], v, x, y],
  50   while length(lst)>0 do (
  51     v : first(lst), lst : rest(lst),
  52     if v = 'node then (
  53       v : first(lst), lst : rest(lst),
  54       x : first(lst), lst : rest(lst),
  55       y : first(lst), lst : rest(lst),
  56       v_pos : cons([v, [x, y]], v_pos))),
  57   v_pos)$
  58
  59 graphviz_positions(G, program) := block(
  60   [command],
  61   write_file(G),
  62   if program = 'dot then
  63     command : concat("dot -Tplain \"",
  64       gp_file_in, "\" > \"", gp_file_out, "\"")
  65   else if program = 'twopi then
  66     command : concat("twopi -Tplain \"",
  67       gp_file_in, "\" > \"", gp_file_out, "\"")
  68   else if program = 'circo then
  69     command : concat("circo -Tplain \"",
  70       gp_file_in, "\" > \"", gp_file_out, "\"")
  71   else if program = 'fdp then
  72     command : concat("fdp -Tplain \"",
  73       gp_file_in, "\" > \"", gp_file_out, "\"")
  74   else
  75     command : concat("neato -Tplain \"",
  76       gp_file_in, "\" > \"", gp_file_out, "\""),
  77   system(command),
  78   read_file())$
  79
  80
  81 /* taken from augmented_lagrangian */
  82 with_parameters ([L]) ::= buildq (
  83   [a : subst (":", "=",  ev (L [1])), e : rest (L)],
  84   block (a, splice (e)) );
  85
  86 draw_graph(G, [options]) := block(
  87   [
  88    maperror : false, mapprint : false, ratprint:false,
  89    wxplot_size : graphs_plot_size,
  90    program : draw_graph_program,
  91    show_id : false, show_label : false, show_weight : false,
  92    vertex_color : 'red, text_color : 'blue, edge_color : 'black,
  93    show_vertex_color : 'blue, show_edge_color : 'blue,
  94    vertex_type : 7, show_vertex_type : 7,
  95    vertex_size : 2, show_vertex_size : 2,
  96    edge_type : solid, show_edge_type : solid,
  97    edge_width : 1, show_edge_width : 2,
  98    head_length : 0.07, head_angle : 15,
  99    vertices:[], edges:[], v_pos, vertex_labels:[], edge_weights:[],
 100    show_vertices : [], show_edges : [], show_path : [],
 101    label_alignment : 'center, label_padding: "  ",
 102    command, x_max, y_max, gp_options,
 103    terminal : draw_graph_terminal, file_name : "graph",
 104    gp_file_in : temp_filename(gp_file_in),
 105    gp_file_out : temp_filename(gp_file_out),
 106    redraw : false, directed : false,
 107    fixed_vertices : [],
 108    spring_embedding_depth : 50,
 109    vertex_colors : [red, blue, "dark-green", orange, purple, cyan, brown],
 110    edge_colors : [red, blue, "dark-green", orange, purple, cyan, brown],
 111    vertex_partition : [],
 112    vertex_coloring : [],
 113    vertex_sizes : [],
 114    vertex_types : [],
 115    edge_partition : [],
 116    edge_coloring : [],
 117    edge_types : [],
 118    edge_widths : [],
 119    dimension : 2,
 120    transform : false,
 121    scene,
 122    loops : [],
 123    normalize_positions : true
 124   ],
 125
 126   if not(is_graph(G)) and not(is_digraph(G)) then
 127     error("First argument to `draw_graph' is not a graph:", G),
 128
 129   if get('wxmaxima, 'version)#false then (
 130     terminal : 'wxmaxima,
 131     if (assoc('terminal, options))=false then (
 132       vertex_size : 1.2,
 133       show_vertex_size : 1.2)),
 134   if is_digraph(G) then directed : true,
 135
 136   if assoc('show_id, options)=true or assoc('show_label, options)=true then (
 137     vertex_size : 3,
 138     show_vertex_size : 3,
 139     vertex_colors : ["light-red", "light-blue", "light-green", orange, purple, cyan, brown],
 140     show_vertex_color : "light-blue",
 141     vertex_color : "light-red"),
 142
 143   with_parameters(options,
 144
 145     /* Get vertex positions */
 146     v_pos : get_positions(G),
 147     if redraw='continue or redraw=true or v_pos=false then (
 148       if member(program, ['neato, 'dot, 'twopi, 'fdp, 'circo]) then
 149         v_pos : graphviz_positions(G, program)
 150       else if program = 'spring_embedding then
 151         v_pos : spring_embedding(G, spring_embedding_depth, fixed_vertices, dimension,
 152           if redraw='continue then true else false)
 153       else if program = 'planar_embedding then block(
 154         [embedding : planar_embedding(G), c],
 155         if embedding=false then
 156           error("The graph is not a 2-connected planar graph")
 157         else (
 158           c : embedding[1],
 159           for i:2 thru length(embedding) do (
 160             if length(embedding[i])>length(c) then c:embedding[i]),
 161           v_pos : spring_embedding(G, spring_embedding_depth, c, 2,
 162             if redraw='continue then true else false)))
 163       else
 164         v_pos : apply(program, [G]),
 165       set_positions(v_pos, G)),
 166     dimension : length(second(first(v_pos))),
 167
 168     /* Normalize positions into [-1,1]x[-1,1] */
 169     if normalize_positions=true and length(v_pos)>1 and dimension=2 then block(
 170       [x_list : map(first, map(second, v_pos)),
 171        y_list : map(second, map(second, v_pos)),
 172        x_min, x_max, y_min, y_max],
 173       x_min : lmin(x_list),
 174       x_max : lmax(x_list),
 175       y_min : lmin(y_list),
 176       y_max : lmax(y_list),
 177
 178       if (x_min#x_max) and (y_min#y_max) then
 179         v_pos : map(
 180           lambda([u],
 181             [u[1],
 182              [(u[2][1] - (x_min + x_max)/2) / (x_max - x_min),
 183               (u[2][2] - (y_min + y_max)/2) / (y_max - y_min)]]),
 184            v_pos)),
 185
 186     /* Setup edges */
 187     if show_path#[] then show_edges: vertices_to_path(show_path),
 188     if edge_coloring=true then edge_coloring: edge_coloring(G),
 189     if show_edges#[] then (
 190       for e in edges(G) do
 191         if not(member(e, show_edges)) then
 192           edges : cons(e, edges),
 193       edge_partition : [edges, show_edges],
 194       edge_widths : [edge_width, show_edge_width],
 195       edge_types : [edge_type, show_edge_type],
 196       edge_colors : [edge_color, show_edge_color])
 197     else if edge_coloring#[] then block(
 198       [ch:first(edge_coloring), coloring:second(edge_coloring)],
 199       edge_partition : makelist(
 200         map(first, sublist(coloring, lambda([u], is(second(u)=c)))),
 201         c, 1, ch))
 202     else if edge_partition=[] then (
 203       edge_colors : [edge_color],
 204       edge_types : [edge_type],
 205       edge_widths : [edge_width],
 206       edge_partition : [edges(G)]),
 207
 208     edges : apply(append,
 209       map(lambda([c,t,w,edg],
 210         append(['color=c, 'line_type=t, 'line_width=w],
 211           map(lambda([u],
 212              block([p1:assoc(u[1], v_pos), p2:assoc(u[2], v_pos)],
 213                if directed=true then
 214                  vector(p1, p2-p1)
 215                else
 216                  points([p1, p2]))),
 217              edg))),
 218        makelist(edge_colors[mod(i, length(edge_colors))+1], i, 0, length(edge_partition)-1),
 219        if edge_types=[] then makelist(edge_type, i, 1, length(edge_partition)) else edge_types,
 220        if edge_widths=[] then makelist(edge_width, i, 1, length(edge_partition)) else edge_widths,
 221        edge_partition)),
 222
 223     /* Setup vertices */
 224     if vertex_coloring=true then vertex_coloring: vertex_coloring(G),
 225     if show_vertices#[] then block(
 226       [show_vertices1 : flatten(show_vertices)],
 227       for v in vertices(G) do
 228         if not(member(v, show_vertices1)) then
 229           vertices : cons(v, vertices),
 230       if not listp(show_vertices[1]) then (
 231         vertex_colors : [vertex_color, show_vertex_color],
 232         vertex_sizes : [vertex_size, show_vertex_size],
 233         vertex_types : [vertex_type, show_vertex_type]),
 234       if listp(show_vertices[1]) then
 235         vertex_partition : cons(vertices, show_vertices)
 236       else
 237         vertex_partition : [vertices, show_vertices])
 238     else if vertex_coloring#[] then block(
 239       [ch:first(vertex_coloring), coloring:second(vertex_coloring)],
 240       vertex_partition : makelist(
 241         map(first, sublist(coloring, lambda([u], is(second(u)=c)))),
 242         c, 1, ch))
 243     else if vertex_partition=[] then (
 244       vertex_colors : [vertex_color],
 245       vertex_sizes : [vertex_size],
 246       vertex_types : [vertex_type],
 247       vertex_partition : [vertices(G)]),
 248
 249     vertices : apply(append,
 250       map(lambda([c,t,s,vrt],
 251           if vrt=[] then []
 252           else ['color=c, 'point_type=t, 'point_size=s, points(map(lambda([u], assoc(u, v_pos)), vrt))]),
 253         makelist(vertex_colors[mod(i, length(vertex_colors))+1], i, 0, length(vertex_partition)-1),
 254         if vertex_types=[] then makelist(vertex_type, i, 1, length(vertex_partition)) else vertex_types,
 255         if vertex_sizes=[] then makelist(vertex_size, i, 1, length(vertex_partition)) else vertex_sizes,
 256         vertex_partition)),
 257
 258     /* Setup vertex labels or ids */
 259     if show_id=true then (
 260       for v in vertices(G) do block(
 261         [p : assoc(v, v_pos)],
 262         vertex_labels : cons([printf(false, "~a~a~a", label_padding, v, label_padding), p[1], p[2]],
 263                              vertex_labels)))
 264     else if show_label=true then (
 265       for v in vertices(G) do block(
 266         [p : assoc(v, v_pos)],
 267         vertex_labels : cons([printf(false, "~a~a~a", label_padding,
 268                                      get_vertex_label(v, G), label_padding),
 269                               p[1], p[2]],
 270                              vertex_labels))),
 271     if length(vertex_labels) > 0 then
 272       vertex_labels : [apply(label, vertex_labels)],
 273
 274     /* Setup loops */
 275     if dimension=2 then
 276       loops : map(lambda([x], block([pos: assoc(x, v_pos)], ellipse(pos[1], pos[2]+0.05,0.05,0.05,0,360))),
 277         loops),
 278
 279     /* Setup edge wieghts */
 280     if show_weight=true then (
 281       for e in edges(G) do block(
 282         [p1 : assoc(e[1], v_pos), p2 : assoc(e[2], v_pos)],
 283         edge_weights : cons([printf(false, "~a", get_edge_weight(e, G)),
 284                              (2*p1[1]+p2[1])/3, (2*p1[2]+p2[2])/3],
 285                             edge_weights))),
 286     if length(edge_weights) > 0 then
 287       edge_weights : [apply(label, edge_weights)],
 288
 289     /* Check if we are in wxmaxima */
 290     if terminal='wxmaxima then (
 291       if dimension=3 then command : wxdraw3d else command : wxdraw2d)
 292     else (
 293       if dimension=3 then command : draw3d else command : draw2d),
 294
 295     if terminal#'wxmaxima then
 296       gp_options : ['terminal = terminal, 'file_name = file_name]
 297     else gp_options : [],
 298
 299     /* plot the graph */
 300     scene : append(
 301        [
 302         'point_type = 0,
 303         'line_type = edge_type,
 304         'line_width = edge_width,
 305         'points_joined = true,
 306         'head_length = head_length,
 307         'head_angle = head_angle,
 308         'axis_3d = false,
 309         'xtics = false,
 310         'ytics = false,
 311         'ztics = false,
 312         'transparent=true,
 313         'xlabel = "",
 314         'ylabel = ""
 315        ],
 316         loops,
 317         edges,
 318        [
 319         'points_joined = false,
 320         'point_size = vertex_size,
 321         'point_type = vertex_type
 322        ],
 323         vertices,
 324        [
 325         'color = text_color,
 326         'label_alignment = label_alignment
 327        ],
 328         vertex_labels,
 329         edge_weights,
 330        [
 331         'axis_top = false,
 332         'axis_bottom = false,
 333         'axis_left = false,
 334         'axis_right = false,
 335         'ytics = false,
 336         'xtics = false
 337        ],
 338         gp_options),
 339
 340       if transform=false then (
 341         apply(command, scene),
 342         'done)
 343       else
 344         scene))$
 345
 346 draw_graph_list(grlist, [options]) :=
 347   if get('wxmaxima, 'version)=false then block(
 348     [scenes],
 349     scenes: map(lambda([g],
 350         apply(gr2d,
 351           append(
 352             apply(draw_graph,
 353               append([g, transform=true], options))))),
 354       grlist),
 355     apply(draw, append(['columns=length(grlist)], scenes)))
 356   else (
 357     if length(grlist)<4 then block(
 358       [scenes, wxplot_size: 2.0/3 * [length(grlist), 1] * graphs_plot_size],
 359       scenes: map(lambda([g],
 360           apply(gr2d,
 361             append(
 362               apply(draw_graph,
 363                 append([g, transform=true], options))))),
 364         grlist),
 365       apply(wxdraw, append(scenes, ['columns=length(grlist)])))
 366     else block(
 367       [display_graphics:false, wxplot_size: 2.0*graphs_plot_size/3],
 368       ldisp(
 369         map(lambda([g],
 370             apply(wxdraw2d,
 371               append(
 372                 apply(draw_graph,
 373                   append([g, transform=true], options))))),
 374           grlist))),
 375     'done)$
 376
 377 vertices_to_path(lst) := block(
 378   [path : []],
 379   while length(lst)>1 do (
 380     path : cons([lst[1], lst[2]], path),
 381     lst : rest(lst)),
 382   path)$
 383
 384 vertices_to_cycle(lst) := vertices_to_path(append(lst, [first(lst)]))$