OKlibrary  0.2.1.6
Visualisation.mac
Go to the documentation of this file.
00001 /* Rui Wang, 28.10.2009 (Swansea) */
00002 /* Copyright 2009, 2010, 2011, 2013 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/Trees/Lisp/ReingoldTilford.mac")$
00023 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")$
00024 
00025 
00026 /* ******************************
00027    * Tree drawing *
00028    ******************************
00029 */
00030 
00031 /* Extract a list of points [[x1,y1], [x2,y2], ... , [xn,yn]] from a labelled
00032    rooted tree T with 2-dimensional coordinates:
00033 */
00034 tdlrt2points(T) := block([nt,nt1,nt2],
00035       if rest(T)=[] then return([T[1][1]]) 
00036       else if length(rest(T))=2 
00037            then ([nt1,nt2]:map(tdlrt2points, rest(T)),
00038                  nt:cons(T[1][1],append(nt1,nt2))) 
00039            else ([nt1]:map(tdlrt2points, rest(T)),
00040                  nt:cons(T[1][1],nt1)),
00041       return(nt))$
00042 
00043 /* Extract a list of edges [[[x1,y1],[x2,y2]], ... , [[xn',yn'],[xn,yn]]] from
00044    a labelled rooted tree T with 2-dimensional coordinates:
00045 */
00046 tdlrt2edges(T) := block([nt,nt1,nt2],
00047       if rest(T)=[] then return(T) 
00048       else if length(rest(T))=2 
00049            then ([nt1,nt2]:map(tdlrt2edges, rest(T)), 
00050                  nt:append(cons([T[1][1],nt1[1][1]],
00051                                 if rest(nt1)=[] and rest(nt1[1])=[] then [] 
00052                                 else nt1),
00053                                 cons([T[1][1],nt2[1][1]],
00054                                      if rest(nt2)=[] and rest(nt2[1])=[] then []
00055                                      else nt2))) 
00056            else ([nt1]:map(tdlrt2edges, rest(T)), 
00057                  nt:cons([T[1][1],nt1[1][1]],
00058                          if rest(nt1)=[] and rest(nt1[1])=[] then [] else nt1)), 
00059       return(nt))$
00060 
00061 
00062 /* Draw an unlabelled rooted tree T, using the Reingold-Tilford algorithm. */
00063 /* Possible parameters are listed as follows:
00064 
00065     T     : an unlabelled rooted tree.
00066     p     : the root coordinates of the tree [x,y]; default [0,0].
00067     xran  : the range for the x coordinate [x_min,x_max]; default auto.
00068     yran  : the range for the y coordinate [y_min,y_max]; default auto.
00069     pts   : the size of a point (a non-negative number); default computed
00070     ptt   : the type of points (either as name or as integer):
00071                 $none (-1)
00072                 dot (0)
00073                 plus (1)
00074                 multiply (2)
00075                 asterisk (3)
00076                 square (4)
00077                 filled_square (5)
00078                 circle (6)
00079                 filled_circle (7) *default*
00080                 up_triangle (8)
00081                 filled_up_triangle (9)
00082                 down_triangle (10)
00083                 filled_down_triangle (11)
00084                 diamant (12)
00085                 filled_diamant (13)
00086     ptc   : the colour of points (red, blue, ...); default red.
00087     edgc  : the colour of edges (red, blue, ...); default blue.
00088     output: if output is set to "true", the tree drawing will be output to a
00089             file called "output.eps" in the current directory. Otherwise, the
00090             tree drawing will be displayed normally.
00091     
00092    T is a compulsory parameter that can be accepted by a function call in the
00093    following ways:  
00094     1. Set T in global (e.g. T:value; then, draw_rt()).
00095     2. Use "T:value" as an argument. (e.g. draw_rt(T:value)).
00096     3. Use the "value" of T as the first argument. (e.g. draw_rt(value)).
00097    The other parameters are optional, the usage of which are similar to the
00098    parameter T which is listed above except 3. Furthermore, the optional 
00099    parameters can be set to "unknown" (e.g. draw_rt(pts:unknown)) so that
00100    the default values of the parameters will be used.
00101 
00102 */
00103 draw_rt(['P]) :=     
00104   block([tdlrt,xdis,ydis,T:T,p:p,xran:xran,yran:yran,
00105          ptt:ptt,pts:pts,ptc:ptc,edgc:edgc,output:output],
00106    if not emptyp(P) and (atom(first(P)) or op(first(P))#":") then
00107     (T:ev(first(P)), ev(rest(P))) else
00108     ev(P),
00109    if p='p or p=unknown then p:[0,0],
00110    if xran='xran or xran=unknown then xran:auto,
00111    if yran='yran or yan=unknown then yran:auto,
00112    if ptt='ptt or ptt=unknown then ptt:filled_circle,
00113    if ptc='ptc or ptc=unknown then ptc:red,
00114    if edgc='edgc or edgc=unknown then edgc:blue,
00115    if output='output or output=unknown then output:false,
00116    tdlrt:reingold_tilford_annotated(T,p), 
00117    xdis:rightmost_x(tdlrt)-leftmost_x(tdlrt),
00118    ydis:y_tdlrt(tdlrt)-y_extreme_tdlrt(tdlrt),
00119    tdlrt:reingold_tilford_remove_annotations(tdlrt),
00120    if pts='pts or pts=unknown then
00121     pts:min(10/(max(xdis,2)^(5/11)),10/(max(ydis,2)^(5/11))),
00122    apply(draw2d,
00123          append([grid=true,xrange = xran,yrange = yran,
00124                  point_size = pts,point_type = ptt,color = ptc,
00125                  points(tdlrt2points(tdlrt)),                 
00126                  color=edgc,transparent=true],
00127                 map(polygon, tdlrt2edges(tdlrt)),
00128                 if output=true then 
00129                 [file_name="output", terminal='eps] else [])),
00130    true)$
00131 
00132 
00133 /* Perform the tree drawing with a labelled rooted tree T. RGB colour model is
00134    used for the colouring schemes.
00135    The compulsory parameter T is a labelled rooted tree. For the usage and 
00136    other possible parameters, please refer to draw_rt.
00137 */
00138 draw_lrt(['P]) := 
00139   block([tdlrt,xdis,ydis,T:T,p:p,xran:xran,yran:yran,
00140          ptt:ptt,pts:pts,ptc:ptc,edgc:edgc,output:output],
00141    if not emptyp(P) and (atom(first(P)) or op(first(P))#":") then
00142     (T:ev(first(P)), ev(rest(P))) else
00143     ev(P),
00144    if p='p or p=unknown then p:[0,0],
00145    if xran='xran or xran=unknown then xran:auto,
00146    if yran='yran or yan=unknown then yran:auto,
00147    if ptt='ptt or ptt=unknown then ptt:filled_circle,
00148    if ptc='ptc or ptc=unknown then ptc:red,
00149    if edgc='edgc or edgc=unknown then edgc:blue,
00150    if output='output or output=unknown then output:false,
00151    tdlrt:reingold_tilford_annotated(lrt2rt(T),p), 
00152    xdis:rightmost_x(tdlrt)-leftmost_x(tdlrt),
00153    ydis:y_tdlrt(tdlrt)-y_extreme_tdlrt(tdlrt),
00154    tdlrt:reingold_tilford_remove_annotations(tdlrt),
00155    if pts='pts or pts=unknown then
00156     pts:min(10/(max(xdis,2)^(5/11)),10/(max(ydis,2)^(5/11))),
00157    apply(draw2d,
00158          append([grid=true,xrange = xran,yrange = yran,
00159                  point_size = pts,point_type = ptt],
00160                 lappend((map(colouring, lrt2value(T),tdlrt2points(tdlrt)))),
00161                 [color=edgc,transparent=true],
00162                 map(polygon, tdlrt2edges(tdlrt)),
00163                 if output=true then 
00164                 [file_name="output", terminal='eps] else [])),
00165    true)$
00166 
00167 
00168 /* Extract the values of labels from a labelled rooted tree T.
00169    The output is a list [label1, label2, ... , labelN], where N equals the 
00170    number of nodes in the labelled rooted tree T. The order of the labels
00171    obeys the rule of a pre-order tree traversal.
00172 */
00173 lrt2value(T) := if length(T) = 1 then [T[1]] else
00174     block([left,right], 
00175           if length(T) = 3 
00176           then ([left,right]: map(lrt2value, rest(T)),
00177                 cons(T[1],append(left,right))) 
00178           else cons(T[1],lrt2value(T[2])))$
00179           
00180           
00181 /* Convert a decimal number to a string in hexadecimal, e.g., 10 -> "0A";
00182    the output is at least two hex-digits (padding with zero if needed), and
00183    the hex-letters are upper-case:
00184 */
00185 dec2hex(n) := if n<16 then sconcat("0",supcase(printf(false,"~x",n)))
00186               else supcase(printf(false,"~x",n))$          
00187 
00188 
00189 /* Convert RGB decimal value to standard Maxima RGB code.
00190    [14,2,51] -> "#0E0233"
00191 */
00192 format_rgb(rgb) := apply(concat,append(["#"],map(dec2hex,rgb)))$    
00193 
00194 
00195 /* Convert a list of values (usually a label in a labelled rooted tree) to    
00196    standard Maxima RGB code.
00197    [value1, value2,...] -> "#rrggbb"
00198 */
00199 /* Currently, the function handles the list that contains only 1 value,
00200    otherwise, the output colour is red ("#FF0000").
00201 */
00202 value2rgb(v) := block([value:if listp(v) then v[1] else v],apply(format_rgb,
00203           [[255-min(value*15,255),min(value,255),min(value*10,255)]]))$
00204 
00205 
00206 /* Binding one colour to one point.
00207 */
00208 colouring(v,p) := [color= value2rgb(v),points([p])]$
00209 
00210 leaves_colour(v,p,c) := block([value:if listp(v) then v[1] else v],
00211              [if value=true then color=c[1] else color=c[2],points([p])])$
00212 
00213 /* Print the labels of the nodes of a binary labelled rooted tree T up to the
00214    depth d, where d is a natural number >= -1. For the nodes of depth <= d
00215    the labels are printed, while otherwise nothing shows. Leaves are
00216    treated differently, where the leaves that are labelled by "true" are shown
00217    with red colour, otherwise grey colour.
00218    The compulsory parameter T is a labelled rooted tree. For the usage and 
00219    other possible parameters, please refer to draw_rt.
00220    Additionally, the following possible parameters are provided for 
00221    draw_lrt_dbl:
00222    
00223     lbc : the colour of labels; default red.
00224     tc  : the colour of true-leaves; default red.
00225     fc  : the colour of false-leaves; default grey.
00226     d   : the maximum depth for which the labels will be printed.
00227            (d is a natural number >= -1).
00228 */
00229 draw_lrt_dbl(['P]) := 
00230   block([nd,tdlrt,xdis,ydis,T:T,p:p,xran:xran,yran:yran,
00231          pts:pts,ptt:ptt,lbc:lbc,edgc:edgc,tc:tc,fc:fc,d:d,output:output],
00232    if not emptyp(P) and (atom(first(P)) or op(first(P))#":") then
00233     (T:ev(first(P)), ev(rest(P))) else
00234     ev(P),
00235    if p='p or p=unknown then p:[0,0],
00236    if ptt='ptt or ptt=unknown then ptt:filled_circle,
00237    if lbc='lbc or lbc=unknown then lbc:red,
00238    if tc='tc or tc=unknown then tc:red,
00239    if fc='fc or fc=unknown then fc:grey,
00240    if edgc='edgc or edgc=unknown then edgc:blue,
00241    if d='d or d=unknown then d:-1,
00242    if output='output or output=unknown then output:false,
00243    tdlrt:reingold_tilford_annotated(lrt2rt(T),p), 
00244    xdis:rightmost_x(tdlrt)-leftmost_x(tdlrt),
00245    ydis:y_tdlrt(tdlrt)-y_extreme_tdlrt(tdlrt),
00246    if xran='xran or xran=unknown then
00247     xran:[leftmost_x(tdlrt)-0.5,rightmost_x(tdlrt)+0.5],
00248    if yran='yran or yan=unknown then
00249     yran:[p[2]-ydis-0.5,p[2]+0.5],
00250    tdlrt:reingold_tilford_remove_annotations(tdlrt),
00251    nd: nodes_division(tdlrt2points(tdlrt),lrt2value(T),d),
00252    if pts='pts or pts=unknown then 
00253     pts:min(10/(max(xdis,2)^(5/11)),10/(max(ydis,2)^(5/11))),
00254    apply(draw2d,
00255          append([grid=true,xrange = xran,yrange = yran,
00256                  point_size = pts,point_type = ptt],
00257                  if not(nd[1]=[]) then
00258                   [color = lbc,label_alignment=left, 
00259                   apply(label,map(cons,map(string,if listp(nd[2][1]) then 
00260                   lappend(nd[2]) else nd[2]),nd[1]+0.1))]
00261                  else [],
00262                  if not(nd[5]=[]) then
00263                   lappend((map(leaves_colour, 
00264                   nd[6],nd[5],create_list([tc,fc],i,1,length(nd[6])))))
00265                  else [],
00266                  [color=edgc,transparent=true],
00267                  map(polygon, tdlrt2edges(tdlrt)),
00268                 if output=true then 
00269                 [file_name="output", terminal='eps] else [])),
00270    true)$
00271 
00272 
00273 /* Dividing the nodes of trees into 3 parts according to the depth d and 
00274    whether nodes are leaves.
00275    Input: a point list pl, a value list vl and depth d.
00276    Output: a list [pointlist1,valuelist1,pointlist2,valuelist2,pointlist3,
00277    valuelist3], where pointlist1 and valuelist1 are relating to the nodes
00278    above the depth d(inclusive), pointlist2 and valuelist2 are relating to
00279    the nodes below the depth d, pointlist3 and valuelist3 are relating to
00280    the nodes which are leaves.
00281 */
00282 nodes_division(pl,vl,d) := 
00283     block([y: pl[1][2]+d*(-1), l:[[],[],[],[],[],[]]],
00284           for i:1 thru length(pl)-1 do
00285             (if i=length(pl) then 
00286               (l[5]:endcons(pl[i],l[5]), l[6]:endcons(vl[i],l[6])) else
00287              if pl[i][2]<=pl[i+1][2] then
00288                (l[5]:endcons(pl[i],l[5]), l[6]:endcons(vl[i],l[6])) else
00289              if pl[i][2]>=y then
00290                (l[1]:endcons(pl[i],l[1]), l[2]:endcons(vl[i],l[2])) else 
00291                (l[3]:endcons(pl[i],l[3]), l[4]:endcons(vl[i],l[4]))),
00292           if length(pl) =1 and d>=0 then
00293             [[pl[1]],[vl[1]],[],[],[],[]] else 
00294           if length(pl) =1 and d=-1 then
00295             [[],[],[pl[1]],[vl[1]],[],[]] else
00296             (l[5]:endcons(pl[length(pl)],l[5]),
00297              l[6]:endcons(vl[length(pl)],l[6]),
00298              l)
00299 )$
00300 
00301 /* Drawing of splitting trees: */
00302 draw_st(['P]) := apply(draw_lrt_dbl, P)$
00303 
00304