]> Creatis software - CreaPhase.git/blobdiff - octave_packages/m/plot/private/__stem__.m
update packages
[CreaPhase.git] / octave_packages / m / plot / private / __stem__.m
diff --git a/octave_packages/m/plot/private/__stem__.m b/octave_packages/m/plot/private/__stem__.m
new file mode 100644 (file)
index 0000000..97fa205
--- /dev/null
@@ -0,0 +1,557 @@
+## Copyright (C) 2006-2012 Michel D. Schmid
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or (at
+## your option) any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {@var{h} =} __stem__ (@var{have_z}, @var{varargin})
+## Undocumented internal function.
+## @end deftypefn
+
+## Author: Michel D. Schmid <michaelschmid@users.sourceforge.net>
+## Adapted-by: jwe
+
+function h = __stem__ (have_z, varargin)
+
+  if (have_z)
+    caller = "stem3";
+  else
+    caller = "stem";
+  endif
+
+  [ax, varargin, nargin] = __plt_get_axis_arg__ (caller, varargin{:});
+
+  [x, y, z, dofill, llc, ls, mmc, ms, varargin] = ...
+      check_stem_arg (have_z, varargin{:});
+
+  oldax = gca ();
+  unwind_protect
+    axes (ax);
+    hold_state = get (ax, "nextplot");
+    newplot ();
+    h = [];
+
+    nx = rows (x);
+    for i = 1: columns (x)
+      if (have_z)
+        xt = x(:)';
+        xt = [xt; xt; NaN(1, nx)](:);
+        yt = y(:)';
+        yt = [yt; yt; NaN(1, nx)](:);
+        zt = z(:)';
+        zt = [zeros(1, nx); zt; NaN(1, nx)](:);
+      else
+        xt = x(:, i)';
+        xt = [xt; xt; NaN(1, nx)](:);
+        yt = y(:, i)';
+        yt = [zeros(1, nx); yt; NaN(1, nx)](:);
+      endif
+
+      hg  = hggroup ();
+      h = [h; hg];
+      args = __add_datasource__ (caller, hg, {"x", "y", "z"}, varargin{:});
+
+      if (i == 1)
+        set (ax, "nextplot", "add");
+      endif
+
+      if (isempty (llc))
+        lc = __next_line_color__ ();
+      else
+        lc = llc;
+      endif
+
+      if (isempty (mmc))
+        mc = lc;
+      else
+        mc = mmc;
+      endif
+
+      if (dofill)
+        fc = mc;
+      else
+        fc = "none";
+      endif
+
+      if (have_z)
+        h_stems = plot3 (xt, yt, zt, "color", lc, "linestyle", ls,
+                         "parent", hg, x, y, z, "color", mc,
+                         "marker",  ms, "linestyle", "none",
+                         "markerfacecolor", fc, "parent", hg);
+
+        h_baseline = [];
+      else
+        h_stems = plot (xt, yt, "color", lc, "linestyle", ls,
+                        "parent", hg, x(:,i), y(:, i), "color", mc, "marker",
+                        ms, "linestyle", "none", "markerfacecolor",
+                        fc, "parent", hg);
+
+        x_axis_range = get (ax, "xlim");
+        h_baseline = line (x_axis_range, [0, 0], "color", [0, 0, 0]);
+        set (h_baseline, "handlevisibility", "off");
+        set (h_baseline, "xliminclude", "off");
+        addlistener (ax, "xlim", @update_xlim);
+        addlistener (h_baseline, "ydata", @update_baseline);
+        addlistener (h_baseline, "visible", @update_baseline);
+      endif
+
+      ## Setup the hggroup and listeners.
+      addproperty ("showbaseline", hg, "radio", "{on}|off");
+      addproperty ("basevalue", hg, "data", 0);
+      addproperty ("baseline", hg, "data", h_baseline);
+
+      if (!have_z)
+        addlistener (hg, "showbaseline", @show_baseline);
+        addlistener (hg, "basevalue", @move_baseline);
+      endif
+
+      addproperty ("color", hg, "linecolor", lc);
+      addproperty ("linewidth", hg, "linelinewidth", 0.5);
+      addproperty ("linestyle", hg, "linelinestyle", ls);
+      addproperty ("marker", hg, "linemarker", ms);
+      addproperty ("markerfacecolor", hg, "linemarkerfacecolor", fc);
+      addproperty ("markersize", hg, "linemarkersize", 6);
+
+      addlistener (hg, "color", @update_props);
+      addlistener (hg, "linewidth", @update_props);
+      addlistener (hg, "linestyle", @update_props);
+      addlistener (hg, "marker", @update_props);
+      addlistener (hg, "markerfacecolor", @update_props);
+      addlistener (hg, "markersize", @update_props);
+
+      addproperty ("xdata", hg, "data", x(:, i));
+      addproperty ("ydata", hg, "data", y(:, i));
+      if (have_z)
+        addproperty ("zdata", hg, "data", z(:, i));
+      else
+        addproperty ("zdata", hg, "data", []);
+      endif
+
+      addlistener (hg, "xdata", @update_data);
+      addlistener (hg, "ydata", @update_data);
+      addlistener (hg, "zdata", @update_data);
+
+      if (! isempty (args))
+        set (hg, args{:});
+      endif
+      if (i == 1 && !isempty(h_baseline))
+        set (h_baseline, "parent", get (hg, "parent"));
+      endif
+    endfor
+
+  unwind_protect_cleanup
+    set (ax, "nextplot", hold_state);
+    axes (oldax);
+  end_unwind_protect
+endfunction
+
+function [x, y, z, dofill, lc, ls, mc, ms, newargs] = check_stem_arg (have_z, varargin)
+
+  ## FIXME -- there seems to be a lot of duplicated code in this
+  ## function.  It seems like it should be possible to simplify things
+  ## by combining some of the nearly identical code sections into
+  ## additional subfunctions.
+
+  if (have_z)
+    caller = "stem3";
+  else
+    caller = "stem";
+  endif
+
+  ## Remove prop/val pairs from data to consider.
+  i = 2;
+  newargs = {};
+  while (i < length (varargin))
+    if (ischar (varargin{i}) && !(strcmpi ("fill", varargin{i})
+                                  || strcmpi ("filled", varargin{i})))
+      newargs{end + 1} = varargin{i};
+      newargs{end + 1} = varargin{i + 1};
+      nargin = nargin - 2;
+      varargin(i:i+1) = [];
+    else
+      i++;
+    endif
+  endwhile
+
+  ## set specifiers to default values.
+  [lc, ls, mc, ms] = set_default_values ();
+  dofill = 0;
+  fill_2 = 0;
+  linespec_2 = 0;
+  z = [];
+
+  ## Check input arguments.
+  if (nargin == 2)
+    if (have_z)
+      z = varargin{1};
+      x = 1:rows (z);
+      y = 1:columns (z);
+    else
+      y = varargin{1};
+      if (isvector (y))
+        x = 1:length (y);
+      elseif (ismatrix (y))
+        x = 1:rows (y);
+      else
+        error ("stem: Y must be a matrix");
+      endif # in each case, x & y will be defined
+    endif
+  elseif (nargin == 3)
+    ## Several possibilities
+    ##
+    ## 1. the real y data
+    ## 2. 'filled'
+    ## 3. line spec
+    if (ischar (varargin{2}))
+      ## Only 2. or 3. possible.
+      if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2}))
+        dofill = 1;
+      else
+        ## Parse the linespec.
+        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2});
+      endif
+      if (have_z)
+        z = varargin{1};
+        x = 1:rows (z);
+        y = 1:columns (z);
+      else
+        y = varargin{1};
+        if (isvector (y))
+          x = 1:length (y);
+        elseif (ismatrix (y))
+          x = 1:rows (y);
+        else
+          error ("stem: Y must be a matrix");
+        endif # in each case, x & y will be defined
+      endif
+    else
+      if (have_z)
+        error ("stem3: must define X, Y and Z");
+      else
+        ## Must be the real y data.
+        x = varargin{1};
+        y = varargin{2};
+        if (! (ismatrix (x) && ismatrix (y)))
+          error ("stem: X and Y must be matrices");
+        endif
+      endif
+    endif
+  elseif (nargin == 4)
+    ## Again, several possibilities:
+    ##
+    ## arg2 1. real y
+    ## arg2 2. 'filled' or linespec
+    ## arg3 1. real z
+    ## arg3 2. 'filled' or linespec
+    if (ischar (varargin{2}))
+      ## Only arg2 2. / arg3 1. & arg3 3. are possible.
+      if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2}))
+        dofill = 1;
+        fill_2 = 1; # Be sure, no second "fill" is in the arguments.
+      else
+        ## Must be a linespec.
+        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2});
+        linespec_2 = 1;
+      endif
+      if (have_z)
+        z = varargin{1};
+        x = 1:rows (z);
+        y = 1:columns (z);
+      else
+        y = varargin{1};
+        if (isvector (y))
+          x = 1:length (y);
+        elseif (ismatrix (y))
+          x = 1:rows (y);
+        else
+          error ("stem: Y must be a matrix");
+        endif # in each case, x & y will be defined
+      endif
+    else
+      if (have_z)
+        x = varargin{1};
+        y = varargin{2};
+        z = varargin{3};
+        if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
+          error ("stem3: X, Y and Z must be matrices");
+        endif
+      else
+        ## must be the real y data.
+        x = varargin{1};
+        y = varargin{2};
+        if (! (ismatrix (x) && ismatrix (y)))
+          error ("stem: X and Y must be matrices");
+        endif
+      endif
+    endif # if ischar(varargin{2})
+    if (! have_z)
+      ## varargin{3} must be char.
+      ## Check for "fill.
+      if ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
+          && fill_2)
+        error ("stem: duplicate fill argument");
+      elseif (strcmpi ("fill", varargin{3}) && linespec_2)
+        ## Must be "fill".
+        dofill = 1;
+        fill_2 = 1;
+      elseif ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
+          && !linespec_2)
+        ## Must be "fill".
+        dofill = 1;
+        fill_2 = 1;
+      elseif (! linespec_2)
+        ## Must be linespec.
+        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3});
+        linespec_2 = 1;
+      endif
+    endif
+  elseif (nargin == 5)
+    if (have_z)
+      x = varargin{1};
+      y = varargin{2};
+      z = varargin{3};
+      if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
+        error ("stem3: X, Y and Z must be matrices");
+      endif
+    else
+      x = varargin{1};
+      y = varargin{2};
+      if (! (ismatrix (x) && ismatrix (y)))
+        error ("stem: X and Y must be matrices");
+      endif
+    endif
+
+    if (! have_z)
+      if (strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled"))
+        dofill = 1;
+        fill_2 = 1; # Be sure, no second "fill" is in the arguments.
+      else
+        ## Must be a linespec.
+        [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3});
+        linespec_2 = 1;
+      endif
+    endif
+
+    ## Check for "fill".
+    if ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
+        && fill_2)
+      error ("%s: duplicate fill argument", caller);
+    elseif ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
+        && linespec_2)
+      ## Must be "fill".
+      dofill = 1;
+      fill_2 = 1;
+    elseif (!strcmpi (varargin{4}, "fill") && !strcmpi (varargin{4}, "filled")
+        && !linespec_2)
+      ## Must be linespec.
+      [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4});
+      linespec_2 = 1;
+    endif
+  elseif (nargin == 6 && have_z)
+    x = varargin{1};
+    y = varargin{2};
+    z = varargin{3};
+    if (! (ismatrix (x) && ismatrix (y) && ismatrix (z)))
+      error ("stem3: X, Y and Z must be matrices");
+    endif
+
+    if (strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled"))
+      dofill = 1;
+      fill_2 = 1; # be sure, no second "fill" is in the arguments
+    else
+      ## Must be a linespec.
+      [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4});
+      linespec_2 = 1;
+    endif
+
+    ## check for "fill" ..
+    if ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled"))
+        && fill_2)
+      error ("stem3: duplicate fill argument");
+    elseif ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled"))
+        && linespec_2)
+      ## Must be "fill".
+      dofill = 1;
+      fill_2 = 1;
+    elseif (!strcmpi (varargin{5}, "fill") && !strcmpi (varargin{5}, "filled")
+            && !linespec_2)
+      ## Must be linespec.
+      [lc, ls, mc, ms] = stem_line_spec (caller, varargin{5});
+      linespec_2 = 1;
+    endif
+  else
+    error ("%s: incorrect number of arguments", caller);
+  endif
+
+  ## Check sizes of x, y and z.
+  if (have_z)
+    if (!size_equal (x, y, z))
+      error ("stem3: inconsistent size of x, y and z");
+    else
+      x = x(:);
+      y = y(:);
+      z = z(:);
+    endif
+  else
+    if (isvector (x))
+      x = x(:);
+      if (isvector (y))
+        if (length (x) != length (y))
+          error ("stem: inconsistent size of x and y");
+        else
+          y = y(:);
+        endif
+      else
+        if (length (x) == rows (y))
+          x = repmat (x(:), 1, columns (y));
+        else
+          error ("stem: inconsistent size of x and y");
+        endif
+      endif
+    elseif (!size_equal (x, y))
+      error ("stem: inconsistent size of x and y");
+    endif
+  endif
+
+endfunction
+
+function [lc, ls, mc, ms] = stem_line_spec (caller, str)
+  if (! ischar (str))
+    error ("%s: expecting argument to be \"fill\" or a string of specifiers",
+           caller);
+  endif
+  [lc, ls, mc, ms] = set_default_values ();
+  ## Parse the line specifier string.
+  cur_props = __pltopt__ ("stem", str, false);
+  for i = 1:length(cur_props)
+    if (isfield (cur_props(i), "color") && ! isempty (cur_props(i).color)); # means line color
+      mc = lc = cur_props(i).color;
+    elseif (isfield (cur_props(i), "linestyle"))
+      ls = cur_props(i).linestyle;
+      if (isempty (ls))
+        ls = __next_line_style__ ();
+      endif
+    elseif (isfield (cur_props(i), "marker") && ! strcmpi (cur_props(i).marker, "none"))
+      ms = cur_props(i).marker;
+      if (isempty (ms))
+        [dummy, ms] = __next_line_style__ ();
+      endif
+    endif
+  endfor
+endfunction
+
+function [lc, ls, mc, ms] = set_default_values ()
+  ## set default values
+  mc = [];
+  lc = [];
+  ls = "-";
+  ms = "o";
+endfunction
+
+function update_xlim (h, d)
+  kids = get (h, "children");
+  xlim = get (h, "xlim");
+
+  for i = 1 : length (kids)
+    obj = get (kids (i));
+    if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline"))
+      if (any (get (obj.baseline, "xdata") != xlim))
+        set (obj.baseline, "xdata", xlim);
+      endif
+    endif
+  endfor
+endfunction
+
+function update_baseline (h, d)
+  visible = get (h, "visible");
+  ydata = get (h, "ydata")(1);
+
+  kids = get (get (h, "parent"), "children");
+  for i = 1 : length (kids)
+    obj = get (kids (i));
+    if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline")
+        && obj.baseline == h)
+      ## Only alter if changed to avoid recursion of the listener functions
+      if (! strcmpi (get (kids(i), "showbaseline"), visible))
+        set (kids (i), "showbaseline", visible);
+      endif
+      if (! strcmpi (get (kids(i), "basevalue"), visible))
+        set (kids (i), "basevalue", ydata);
+      endif
+    endif
+  endfor
+endfunction
+
+function show_baseline (h, d)
+  set (get (h, "baseline"), "visible", get (h, "showbaseline"));
+endfunction
+
+function move_baseline (h, d)
+  b0 = get (h, "basevalue");
+  bl = get (h, "baseline");
+
+  if (get (bl, "ydata") != [b0, b0])
+    set (bl, "ydata", [b0, b0]);
+  endif
+
+  kids = get (h, "children");
+  yt = get(h, "ydata")(:)';
+  ny = length (yt);
+  yt = [b0 * ones(1, ny); yt; NaN(1, ny)](:);
+  set (kids(2), "ydata", yt);
+endfunction
+
+function update_props (h, d)
+  kids = get (h, "children");
+  set (kids(2), "color", get (h, "color"),
+       "linewidth", get (h, "linewidth"),
+       "linestyle", get (h, "linestyle"));
+  set (kids(1), "color", get (h, "color"),
+       "marker", get (h, "marker"),
+       "markerfacecolor", get (h, "markerfacecolor"),
+       "markersize", get (h, "markersize"));
+endfunction
+
+function update_data (h, d)
+  x = get (h, "xdata");
+  y = get (h, "ydata");
+  z = get (h, "zdata");
+
+  if (!isempty (z) && size_equal (x, y, z))
+    error ("stem3: inconsistent size of x, y and z");
+  elseif (numel(x) != numel (y))
+    error ("stem: inconsistent size of x and y");
+  else
+    bl = get (h, "basevalue");
+    nx = numel (x);
+    x = x(:)';
+    xt = [x; x; NaN(1, nx)](:);
+    if (! isempty (z))
+      y = y(:)';
+      yt = [y; y; NaN(1, nx)](:);
+      z = z(:)';
+      zt = [bl * ones(1, nx); z; NaN(1, nx)](:);
+    else
+      y = y(:)';
+      yt = [bl * ones(1, nx); y; NaN(1, nx)](:);
+      zt = [];
+    endif
+
+    kids = get (h, "children");
+    set (kids(2), "xdata", xt, "ydata", yt, "zdata", zt);
+    set (kids(1), "xdata", x, "ydata", y, "zdata", z);
+  endif
+endfunction