octave_packages/m/plot/private/__stem__.m

   1 ## Copyright (C) 2006-2012 Michel D. Schmid
   2 ##
   3 ## This file is part of Octave.
   4 ##
   5 ## Octave is free software; you can redistribute it and/or modify it
   6 ## under the terms of the GNU General Public License as published by
   7 ## the Free Software Foundation; either version 3 of the License, or (at
   8 ## your option) any later version.
   9 ##
  10 ## Octave is distributed in the hope that it will be useful, but
  11 ## WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ## General Public License for more details.
  14 ##
  15 ## You should have received a copy of the GNU General Public License
  16 ## along with Octave; see the file COPYING.  If not, see
  17 ## <http://www.gnu.org/licenses/>.
  18
  19 ## -*- texinfo -*-
  20 ## @deftypefn {Function File} {@var{h} =} __stem__ (@var{have_z}, @var{varargin})
  21 ## Undocumented internal function.
  22 ## @end deftypefn
  23
  24 ## Author: Michel D. Schmid <michaelschmid@users.sourceforge.net>
  25 ## Adapted-by: jwe
  26
  27 function h = __stem__ (have_z, varargin)
  28
  29   if (have_z)
  30     caller = "stem3";
  31   else
  32     caller = "stem";
  33   endif
  34
  35   [ax, varargin, nargin] = __plt_get_axis_arg__ (caller, varargin{:});
  36
  37   [x, y, z, dofill, llc, ls, mmc, ms, varargin] = ...
  38       check_stem_arg (have_z, varargin{:});
  39
  40   oldax = gca ();
  41   unwind_protect
  42     axes (ax);
  43     hold_state = get (ax, "nextplot");
  44     newplot ();
  45     h = [];
  46
  47     nx = rows (x);
  48     for i = 1: columns (x)
  49       if (have_z)
  50         xt = x(:)';
  51         xt = [xt; xt; NaN(1, nx)](:);
  52         yt = y(:)';
  53         yt = [yt; yt; NaN(1, nx)](:);
  54         zt = z(:)';
  55         zt = [zeros(1, nx); zt; NaN(1, nx)](:);
  56       else
  57         xt = x(:, i)';
  58         xt = [xt; xt; NaN(1, nx)](:);
  59         yt = y(:, i)';
  60         yt = [zeros(1, nx); yt; NaN(1, nx)](:);
  61       endif
  62
  63       hg  = hggroup ();
  64       h = [h; hg];
  65       args = __add_datasource__ (caller, hg, {"x", "y", "z"}, varargin{:});
  66
  67       if (i == 1)
  68         set (ax, "nextplot", "add");
  69       endif
  70
  71       if (isempty (llc))
  72         lc = __next_line_color__ ();
  73       else
  74         lc = llc;
  75       endif
  76
  77       if (isempty (mmc))
  78         mc = lc;
  79       else
  80         mc = mmc;
  81       endif
  82
  83       if (dofill)
  84         fc = mc;
  85       else
  86         fc = "none";
  87       endif
  88
  89       if (have_z)
  90         h_stems = plot3 (xt, yt, zt, "color", lc, "linestyle", ls,
  91                          "parent", hg, x, y, z, "color", mc,
  92                          "marker",  ms, "linestyle", "none",
  93                          "markerfacecolor", fc, "parent", hg);
  94
  95         h_baseline = [];
  96       else
  97         h_stems = plot (xt, yt, "color", lc, "linestyle", ls,
  98                         "parent", hg, x(:,i), y(:, i), "color", mc, "marker",
  99                         ms, "linestyle", "none", "markerfacecolor",
 100                         fc, "parent", hg);
 101
 102         x_axis_range = get (ax, "xlim");
 103         h_baseline = line (x_axis_range, [0, 0], "color", [0, 0, 0]);
 104         set (h_baseline, "handlevisibility", "off");
 105         set (h_baseline, "xliminclude", "off");
 106         addlistener (ax, "xlim", @update_xlim);
 107         addlistener (h_baseline, "ydata", @update_baseline);
 108         addlistener (h_baseline, "visible", @update_baseline);
 109       endif
 110
 111       ## Setup the hggroup and listeners.
 112       addproperty ("showbaseline", hg, "radio", "{on}|off");
 113       addproperty ("basevalue", hg, "data", 0);
 114       addproperty ("baseline", hg, "data", h_baseline);
 115
 116       if (!have_z)
 117         addlistener (hg, "showbaseline", @show_baseline);
 118         addlistener (hg, "basevalue", @move_baseline);
 119       endif
 120
 121       addproperty ("color", hg, "linecolor", lc);
 122       addproperty ("linewidth", hg, "linelinewidth", 0.5);
 123       addproperty ("linestyle", hg, "linelinestyle", ls);
 124       addproperty ("marker", hg, "linemarker", ms);
 125       addproperty ("markerfacecolor", hg, "linemarkerfacecolor", fc);
 126       addproperty ("markersize", hg, "linemarkersize", 6);
 127
 128       addlistener (hg, "color", @update_props);
 129       addlistener (hg, "linewidth", @update_props);
 130       addlistener (hg, "linestyle", @update_props);
 131       addlistener (hg, "marker", @update_props);
 132       addlistener (hg, "markerfacecolor", @update_props);
 133       addlistener (hg, "markersize", @update_props);
 134
 135       addproperty ("xdata", hg, "data", x(:, i));
 136       addproperty ("ydata", hg, "data", y(:, i));
 137       if (have_z)
 138         addproperty ("zdata", hg, "data", z(:, i));
 139       else
 140         addproperty ("zdata", hg, "data", []);
 141       endif
 142
 143       addlistener (hg, "xdata", @update_data);
 144       addlistener (hg, "ydata", @update_data);
 145       addlistener (hg, "zdata", @update_data);
 146
 147       if (! isempty (args))
 148         set (hg, args{:});
 149       endif
 150       if (i == 1 && !isempty(h_baseline))
 151         set (h_baseline, "parent", get (hg, "parent"));
 152       endif
 153     endfor
 154
 155   unwind_protect_cleanup
 156     set (ax, "nextplot", hold_state);
 157     axes (oldax);
 158   end_unwind_protect
 159 endfunction
 160
 161 function [x, y, z, dofill, lc, ls, mc, ms, newargs] = check_stem_arg (have_z, varargin)
 162
 163   ## FIXME -- there seems to be a lot of duplicated code in this
 164   ## function.  It seems like it should be possible to simplify things
 165   ## by combining some of the nearly identical code sections into
 166   ## additional subfunctions.
 167
 168   if (have_z)
 169     caller = "stem3";
 170   else
 171     caller = "stem";
 172   endif
 173
 174   ## Remove prop/val pairs from data to consider.
 175   i = 2;
 176   newargs = {};
 177   while (i < length (varargin))
 178     if (ischar (varargin{i}) && !(strcmpi ("fill", varargin{i})
 179                                   || strcmpi ("filled", varargin{i})))
 180       newargs{end + 1} = varargin{i};
 181       newargs{end + 1} = varargin{i + 1};
 182       nargin = nargin - 2;
 183       varargin(i:i+1) = [];
 184     else
 185       i++;
 186     endif
 187   endwhile
 188
 189   ## set specifiers to default values.
 190   [lc, ls, mc, ms] = set_default_values ();
 191   dofill = 0;
 192   fill_2 = 0;
 193   linespec_2 = 0;
 194   z = [];
 195
 196   ## Check input arguments.
 197   if (nargin == 2)
 198     if (have_z)
 199       z = varargin{1};
 200       x = 1:rows (z);
 201       y = 1:columns (z);
 202     else
 203       y = varargin{1};
 204       if (isvector (y))
 205         x = 1:length (y);
 206       elseif (ismatrix (y))
 207         x = 1:rows (y);
 208       else
 209         error ("stem: Y must be a matrix");
 210       endif # in each case, x & y will be defined
 211     endif
 212   elseif (nargin == 3)
 213     ## Several possibilities
 214     ##
 215     ## 1. the real y data
 216     ## 2. 'filled'
 217     ## 3. line spec
 218     if (ischar (varargin{2}))
 219       ## Only 2. or 3. possible.
 220       if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2}))
 221         dofill = 1;
 222       else
 223         ## Parse the linespec.
 224         [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2});
 225       endif
 226       if (have_z)
 227         z = varargin{1};
 228         x = 1:rows (z);
 229         y = 1:columns (z);
 230       else
 231         y = varargin{1};
 232         if (isvector (y))
 233           x = 1:length (y);
 234         elseif (ismatrix (y))
 235           x = 1:rows (y);
 236         else
 237           error ("stem: Y must be a matrix");
 238         endif # in each case, x & y will be defined
 239       endif
 240     else
 241       if (have_z)
 242         error ("stem3: must define X, Y and Z");
 243       else
 244         ## Must be the real y data.
 245         x = varargin{1};
 246         y = varargin{2};
 247         if (! (ismatrix (x) && ismatrix (y)))
 248           error ("stem: X and Y must be matrices");
 249         endif
 250       endif
 251     endif
 252   elseif (nargin == 4)
 253     ## Again, several possibilities:
 254     ##
 255     ## arg2 1. real y
 256     ## arg2 2. 'filled' or linespec
 257     ## arg3 1. real z
 258     ## arg3 2. 'filled' or linespec
 259     if (ischar (varargin{2}))
 260       ## Only arg2 2. / arg3 1. & arg3 3. are possible.
 261       if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2}))
 262         dofill = 1;
 263         fill_2 = 1; # Be sure, no second "fill" is in the arguments.
 264       else
 265         ## Must be a linespec.
 266         [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2});
 267         linespec_2 = 1;
 268       endif
 269       if (have_z)
 270         z = varargin{1};
 271         x = 1:rows (z);
 272         y = 1:columns (z);
 273       else
 274         y = varargin{1};
 275         if (isvector (y))
 276           x = 1:length (y);
 277         elseif (ismatrix (y))
 278           x = 1:rows (y);
 279         else
 280           error ("stem: Y must be a matrix");
 281         endif # in each case, x & y will be defined
 282       endif
 283     else
 284       if (have_z)
 285         x = varargin{1};
 286         y = varargin{2};
 287         z = varargin{3};
 288         if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
 289           error ("stem3: X, Y and Z must be matrices");
 290         endif
 291       else
 292         ## must be the real y data.
 293         x = varargin{1};
 294         y = varargin{2};
 295         if (! (ismatrix (x) && ismatrix (y)))
 296           error ("stem: X and Y must be matrices");
 297         endif
 298       endif
 299     endif # if ischar(varargin{2})
 300     if (! have_z)
 301       ## varargin{3} must be char.
 302       ## Check for "fill.
 303       if ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
 304           && fill_2)
 305         error ("stem: duplicate fill argument");
 306       elseif (strcmpi ("fill", varargin{3}) && linespec_2)
 307         ## Must be "fill".
 308         dofill = 1;
 309         fill_2 = 1;
 310       elseif ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
 311           && !linespec_2)
 312         ## Must be "fill".
 313         dofill = 1;
 314         fill_2 = 1;
 315       elseif (! linespec_2)
 316         ## Must be linespec.
 317         [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3});
 318         linespec_2 = 1;
 319       endif
 320     endif
 321   elseif (nargin == 5)
 322     if (have_z)
 323       x = varargin{1};
 324       y = varargin{2};
 325       z = varargin{3};
 326       if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
 327         error ("stem3: X, Y and Z must be matrices");
 328       endif
 329     else
 330       x = varargin{1};
 331       y = varargin{2};
 332       if (! (ismatrix (x) && ismatrix (y)))
 333         error ("stem: X and Y must be matrices");
 334       endif
 335     endif
 336
 337     if (! have_z)
 338       if (strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
 339         dofill = 1;
 340         fill_2 = 1; # Be sure, no second "fill" is in the arguments.
 341       else
 342         ## Must be a linespec.
 343         [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3});
 344         linespec_2 = 1;
 345       endif
 346     endif
 347
 348     ## Check for "fill".
 349     if ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
 350         && fill_2)
 351       error ("%s: duplicate fill argument", caller);
 352     elseif ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
 353         && linespec_2)
 354       ## Must be "fill".
 355       dofill = 1;
 356       fill_2 = 1;
 357     elseif (!strcmpi (varargin{4}, "fill") && !strcmpi (varargin{4}, "filled")
 358         && !linespec_2)
 359       ## Must be linespec.
 360       [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4});
 361       linespec_2 = 1;
 362     endif
 363   elseif (nargin == 6 && have_z)
 364     x = varargin{1};
 365     y = varargin{2};
 366     z = varargin{3};
 367     if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
 368       error ("stem3: X, Y and Z must be matrices");
 369     endif
 370
 371     if (strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
 372       dofill = 1;
 373       fill_2 = 1; # be sure, no second "fill" is in the arguments
 374     else
 375       ## Must be a linespec.
 376       [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4});
 377       linespec_2 = 1;
 378     endif
 379
 380     ## check for "fill" ..
 381     if ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled"))
 382         && fill_2)
 383       error ("stem3: duplicate fill argument");
 384     elseif ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled"))
 385         && linespec_2)
 386       ## Must be "fill".
 387       dofill = 1;
 388       fill_2 = 1;
 389     elseif (!strcmpi (varargin{5}, "fill") && !strcmpi (varargin{5}, "filled")
 390             && !linespec_2)
 391       ## Must be linespec.
 392       [lc, ls, mc, ms] = stem_line_spec (caller, varargin{5});
 393       linespec_2 = 1;
 394     endif
 395   else
 396     error ("%s: incorrect number of arguments", caller);
 397   endif
 398
 399   ## Check sizes of x, y and z.
 400   if (have_z)
 401     if (!size_equal (x, y, z))
 402       error ("stem3: inconsistent size of x, y and z");
 403     else
 404       x = x(:);
 405       y = y(:);
 406       z = z(:);
 407     endif
 408   else
 409     if (isvector (x))
 410       x = x(:);
 411       if (isvector (y))
 412         if (length (x) != length (y))
 413           error ("stem: inconsistent size of x and y");
 414         else
 415           y = y(:);
 416         endif
 417       else
 418         if (length (x) == rows (y))
 419           x = repmat (x(:), 1, columns (y));
 420         else
 421           error ("stem: inconsistent size of x and y");
 422         endif
 423       endif
 424     elseif (!size_equal (x, y))
 425       error ("stem: inconsistent size of x and y");
 426     endif
 427   endif
 428
 429 endfunction
 430
 431 function [lc, ls, mc, ms] = stem_line_spec (caller, str)
 432   if (! ischar (str))
 433     error ("%s: expecting argument to be \"fill\" or a string of specifiers",
 434            caller);
 435   endif
 436   [lc, ls, mc, ms] = set_default_values ();
 437   ## Parse the line specifier string.
 438   cur_props = __pltopt__ ("stem", str, false);
 439   for i = 1:length(cur_props)
 440     if (isfield (cur_props(i), "color") && ! isempty (cur_props(i).color)); # means line color
 441       mc = lc = cur_props(i).color;
 442     elseif (isfield (cur_props(i), "linestyle"))
 443       ls = cur_props(i).linestyle;
 444       if (isempty (ls))
 445         ls = __next_line_style__ ();
 446       endif
 447     elseif (isfield (cur_props(i), "marker") && ! strcmpi (cur_props(i).marker, "none"))
 448       ms = cur_props(i).marker;
 449       if (isempty (ms))
 450         [dummy, ms] = __next_line_style__ ();
 451       endif
 452     endif
 453   endfor
 454 endfunction
 455
 456 function [lc, ls, mc, ms] = set_default_values ()
 457   ## set default values
 458   mc = [];
 459   lc = [];
 460   ls = "-";
 461   ms = "o";
 462 endfunction
 463
 464 function update_xlim (h, d)
 465   kids = get (h, "children");
 466   xlim = get (h, "xlim");
 467
 468   for i = 1 : length (kids)
 469     obj = get (kids (i));
 470     if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline"))
 471       if (any (get (obj.baseline, "xdata") != xlim))
 472         set (obj.baseline, "xdata", xlim);
 473       endif
 474     endif
 475   endfor
 476 endfunction
 477
 478 function update_baseline (h, d)
 479   visible = get (h, "visible");
 480   ydata = get (h, "ydata")(1);
 481
 482   kids = get (get (h, "parent"), "children");
 483   for i = 1 : length (kids)
 484     obj = get (kids (i));
 485     if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline")
 486         && obj.baseline == h)
 487       ## Only alter if changed to avoid recursion of the listener functions
 488       if (! strcmpi (get (kids(i), "showbaseline"), visible))
 489         set (kids (i), "showbaseline", visible);
 490       endif
 491       if (! strcmpi (get (kids(i), "basevalue"), visible))
 492         set (kids (i), "basevalue", ydata);
 493       endif
 494     endif
 495   endfor
 496 endfunction
 497
 498 function show_baseline (h, d)
 499   set (get (h, "baseline"), "visible", get (h, "showbaseline"));
 500 endfunction
 501
 502 function move_baseline (h, d)
 503   b0 = get (h, "basevalue");
 504   bl = get (h, "baseline");
 505
 506   if (get (bl, "ydata") != [b0, b0])
 507     set (bl, "ydata", [b0, b0]);
 508   endif
 509
 510   kids = get (h, "children");
 511   yt = get(h, "ydata")(:)';
 512   ny = length (yt);
 513   yt = [b0 * ones(1, ny); yt; NaN(1, ny)](:);
 514   set (kids(2), "ydata", yt);
 515 endfunction
 516
 517 function update_props (h, d)
 518   kids = get (h, "children");
 519   set (kids(2), "color", get (h, "color"),
 520        "linewidth", get (h, "linewidth"),
 521        "linestyle", get (h, "linestyle"));
 522   set (kids(1), "color", get (h, "color"),
 523        "marker", get (h, "marker"),
 524        "markerfacecolor", get (h, "markerfacecolor"),
 525        "markersize", get (h, "markersize"));
 526 endfunction
 527
 528 function update_data (h, d)
 529   x = get (h, "xdata");
 530   y = get (h, "ydata");
 531   z = get (h, "zdata");
 532
 533   if (!isempty (z) && size_equal (x, y, z))
 534     error ("stem3: inconsistent size of x, y and z");
 535   elseif (numel(x) != numel (y))
 536     error ("stem: inconsistent size of x and y");
 537   else
 538     bl = get (h, "basevalue");
 539     nx = numel (x);
 540     x = x(:)';
 541     xt = [x; x; NaN(1, nx)](:);
 542     if (! isempty (z))
 543       y = y(:)';
 544       yt = [y; y; NaN(1, nx)](:);
 545       z = z(:)';
 546       zt = [bl * ones(1, nx); z; NaN(1, nx)](:);
 547     else
 548       y = y(:)';
 549       yt = [bl * ones(1, nx); y; NaN(1, nx)](:);
 550       zt = [];
 551     endif
 552
 553     kids = get (h, "children");
 554     set (kids(2), "xdata", xt, "ydata", yt, "zdata", zt);
 555     set (kids(1), "xdata", x, "ydata", y, "zdata", z);
 556   endif
 557 endfunction