/*               COPYRIGHT NOTICE

Copyright (C) 2005-2010 Mario Rodriguez Riotorto

This program 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 2 
of the License, or (at your option) any later version. 

This program 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 at
http://www.gnu.org/copyleft/gpl.html
*/


/*             INTRODUCTION

This is a set of Maxima functions for descriptive statistics.

This library supports two types of data:
 a) lists storing univariate samples, like [34,23,76,45,32,...]
    Example:
        (%i1) mean([a,b,c]);
                     c + b + a
        (%o1)        ---------
                         3
 b) matrices storing multivariate samples, like
    matrix([34,44,23],[87,23,54],....); in this case, the number
    of columns equals the dimension of the multivariate random
    variable, and the number of rows is the sample size.
    Example:
        (%i2) matrix([a,b],[c,d],[e,f]);
                            [ a  b ]
                            [      ]
        (%o2)               [ c  d ]
                            [      ]
                            [ e  f ]
        (%i3) mean(%);
                      e + c + a  f + d + b
        (%o3)        [---------, ---------]
                          3          3

Lists of multiple samples with equal or different sizes are not
directly supported, but you can use the function 'map' as in the
following example:
        (%i4) map(mean,[[a,b,c],[a,b]]);
                        c + b + a  b + a
        (%o4)          [---------, -----]
                            3        2

These are the functions implemented in this library,
(see comments bellow for interpretation):


Data manipulation 
   continuous_freq: frequencies for continuous data
   discrete_freq: frequencies for discrete data
   subsample: subsample extraction

Univariate descriptive statistics:
   mean: sample mean
   smin: sample minimum value
   smax: sample maximum value
   range: the range
   noncentral_moment: non central moment
   central_moment: central moment
   var: variance (divided by n)
   std: standard deviation based on var
   var1: variance (divided by n-1)
   std1: standard deviation based on var1
   median: median
   quantile: p-quantile
   qrange: interquartilic range
   skewness: skewness coefficient
   kurtosis: kurtosis coefficient
   harmonic_mean: harmonic mean
   geometric_mean: geometric mean
   cv: variation coefficient
   mean_deviation: mean deviation
   median_deviation: median deviation
   pearson_skewness: Pearson's skewness coefficient
   quartile_skewness: quartilic skewness coefficient

Multivariate descriptive statistics:
   cov: covariance matrix (divided by n)
   cov1: covariance matrix (divided by n-1)
   cor: correlation matrix
   global_variances: gives a list with
      total variance
      mean variance
      generalized variance
      generalized standard deviation
      efective variance
      efective standard deviation
   list_correlations: gives a list with
      precision matrix
      multiple correlation coefficients
      partial correlation coefficients

Statistical diagrams
   dataplot: data visualization in 2D and 3D
   histogram: frequencies for continuous data
   barsplot: frequencies for discrete, numeric or categorical, data
   boxplot: box diagrams

References:
   Johnson, A.J., Wichern, D.W. (1998) Applied Multivariate Statistical
      Analysis. Prentice Hall.
   Pe~na, D. (2002) An'alisis de datos multivariantes. McGraw-Hill.

Thanks to Robert Dodier and Barton Willis for their help.

For questions, suggestions, bugs and the like, feel free
to contact me at

mario AT edu DOT xunta DOT es
www.biomates.net
*/


put('descriptive, 1, 'version) $

if not get('draw,'version) then load("draw") $



/*            AUXILIARY FUCTIONS                   */


/* If draw package is not loaded, load it */
if not draw_loaded = true then load(draw)$


/* Computes the trace of a matrix */
matrixtrace(m):=block([n:length(m)],
   if matrixp(m) and n=length(m[1])
      then apply("+",makelist(m[i,i],i,1,n)))$


/* True if the argument is a list of numbers, false otherwise. */
listofnumbersp(y):=listp(y) and every('identity,map('numberp,y))$


/* True if the argument is a list containing     */
/* no lists, false otherwise.                    */
listofexpr(y):=listp(y) and not some('identity,map('listp,y))$


/* True if the argument is a list of lists containing only numbers, */
/* false otherwise.                                                 */
listoflistsp(y):=listp(y) and every('identity,map('listofnumbersp,y))$


/* After checking whether Maxima is running on Windows or not,  */
/* calls gnuplot to plot diagrams.                              */
/* Windows => *autoconf-win32* = true => 4 letters              */
/* Linux   => *autoconf-win32* = false => 5 letters             */
/* This is a workaround and I don't know a better way for doing */
/* it.                                                          */
callgnuplot(persist):=
   if persist then
      if ?length(?\*autoconf\-win32\*) = 4
         then system("wgnuplot maxout.gnuplot -")
         else system("(gnuplot -persist maxout.gnuplot)&")
   else
      if ?length(?\*autoconf\-win32\*) = 4
         then system("wgnuplot maxout.gnuplot")
         else system("gnuplot maxout.gnuplot")$


/*               DATA MANIPULATION                 */


/* Sub-sample matrix selection.                                */
/*   Example: subsample(m,lambda([v],v[1]<3 and v[4]=A),3,2)   */
/*   gives the 3rd an 2nd components, in this order, of        */
/*   those rows of matrix m whose first component is           */
/*   less than 3 and fourth component equals A.                */
subsample(mat,cond,[cols]):=
  block([tempvect, tempmat:[]],
    if length(cols)=0
      then cols: makelist(i,i,1,length(mat[1])),
    for obs in mat do
      if cond(obs)
        then
          (tempvect: [],
           for i in cols do
             tempvect: endcons(obs[i], tempvect),
           tempmat: endcons(tempvect, tempmat)),
    apply('matrix, tempmat))$


/* Divides the range in intervals and counts how many values */
/* are inside them. The second argument is optional and      */
/* equals the number of classes we want; 10 by default.      */
/* Argument 'lis' must be a list of real numbers.            */
/* If sample values are all equal, this function returns only */
/* one class of amplitude 2                                  */
continuous_freq(lis,[opt]):=block([numer:true,nc,mini,lim,amp,fr,ult,n,k],
   if length(opt)=1
      then nc:opt[1]
      else nc:10,   /* default number of classes */
   mini: lmin(lis),
   lim:[mini],
   amp:(lmax(lis)-mini)/nc,
   if amp=0
     then [[lis[1]-1,lis[1]+1],[length(lis)]]
     else ( for i:1 thru nc do lim:endcons(mini+amp*i,lim),
            lis:sort(lis),
            fr:makelist(0,i,1,nc),
            n:length(lis),
            k:1,
            for c:1 thru nc-1 do
               while lis[k]<=lim[c+1] do(
                  fr[c]:fr[c]+1,
                  k:k+1),
            fr[nc]: n-apply("+",fr),
            [lim,fr])   )$


/* Counts the frequency of each element in 'lis', its elements */
/* can be numbers, Maxima expressions or strings.              */
discrete_freq(lis):=block([n:length(lis),fr:[],sum,val,set:[],c],
   lis: sort(lis),
   c:1,
   while c<=n do(
      sum: 0,
      val: lis[c],
      set: endcons(val,set),
      while c<=n and lis[c]=val do(
         sum: sum+1,
         c: c+1),
      fr: endcons(sum,fr) ),
   [set,fr]  )$


/*       UNIVARIATE DESCRIPTIVE STATISTICS         */


/* Arithmetic mean */
mean(x) := block([listarith:true],
   if listofexpr(x) or matrixp(x)
      then apply("+", args(x)) / length(x)
      else error("Input to 'mean' must be a list of expressions or a matrix"))$


/* Minimum value */
smin(x):=block([t],
   if matrixp(x)
      then (t:transpose(x),
            makelist(lmin(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then lmin(x)
           else error("Input to 'smin' must be a list of expressions or a matrix"))$


/* Maximum value */
smax(x):=block([t],
   if matrixp(x)
      then (t:transpose(x),
            makelist(lmax(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then lmax(x)
           else error("Input to 'smax' must be a list of expressions or a matrix"))$


/* mini and maxi are maintained for backward compatibility,
   but removed from documentation. */
mini(x):= smin(x) $
maxi(x):= smax(x) $

/* Range */
range(x):=block([t],
   if matrixp(x)
      then (t:transpose(x),
            makelist(range(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then lmax(x) - lmin(x)
           else error("Input to 'range' must be a list of expressions or a matrix"))$


/* Non central moment of order m */
noncentral_moment(x,m) := block([listarith:true],
   if listofexpr(x) or matrixp(x)
      then apply("+", args(x)^m) / length(x)
      else error("Input to 'noncentral_moment' must be a list of expressions or a matrix"))$


/* Central moment of order m */
central_moment(x,m):=block([n:length(x),listarith:true,me:mean(x)],
   if matrixp(x)
      then apply("+",makelist((x[i]-me)^m,i,1,n)) / n
      else if listofexpr(x)
           then apply("+",(x-me)^m) / n
           else error("Input to 'central_moment' must be a list of expressions or a matrix"))$


/* Maximum likelihood estimator of variance */
var(x):=central_moment(x,2)$


/* Standard deviation as the root square of var */
std(x):=block([listarith:true],sqrt(var(x)))$


/* Unbiased estimator of variance (divided by n-1) */
var1(x):=block([n:length(x),listarith:true],var(x)*n/(n-1))$


/* Standard deviation as the root square of var1 */
std1(x):=block([listarith:true],sqrt(var1(x)))$


/* Median */
median(x):=block([n,s,t],
   if listofexpr(x)
      then (n:length(x),
            s:sort(x),
            if oddp(n)
               then s[(n+1) / 2]
               else (s[n/2] + s[n/2 + 1]) / 2  )
      else if matrixp(x)
           then (t:transpose(x),
                 makelist(median(t[i]),i,1,length(t)))
           else error("Input to 'median' must be a list of expressions or a matrix"))$


/* p-quantile, with 0<=p<=1. Linear interpolation */
quantile(x,p):=block([n,s,pos,int,dif,t],
   if numberp(p) and p>=0 and p<=1
      then if listofexpr(x)
           then (n:length(x),
                 s:sort(x),
                 pos:p*(n-1)+1,
                 int:floor(pos),
                 dif:pos-int,
                 if abs(dif)<1.0e-15
                    then s[int]
                    else (1-dif)*s[int]+dif*s[int+1])
           else if matrixp(x)
                then (t:transpose(x),
                      makelist(quantile(t[i],p),i,1,length(t)))
                else error("First argument of 'quantile' must be a list of expressions or a matrix")
      else error("Second argument of 'quantile' must be a probability") )$


/* Interquartilic range */
qrange(x):=block([t],
   if matrixp(x)
      then (t:transpose(x),
            makelist(qrange(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then quantile(x,3/4)-quantile(x,1/4)
           else error("Input to 'qrange' must be a list of expressions or a matrix"))$


/* Skewness coefficient */
skewness(x):=block([listarith:true],central_moment(x,3)/std(x)^3)$


/* Kurtosis coefficient, sometimes called kurtosis excess (see the -3) */
kurtosis(x):=block([listarith:true],central_moment(x,4)/var(x)^2 - 3)$


/* Harmonic mean */
harmonic_mean(x):=block([listarith:true],
   if listofexpr(x) or matrixp(x)
      then length(x) / apply("+", 1/args(x))
      else error("Input to 'harmonic_mean' must be a list of expressions or a matrix"))$


/* Geometric mean */
geometric_mean(x):=block([listarith:true],
   if listofexpr(x) or matrixp(x)
      then apply("*", args(x))^(1/length(x))
      else error("Input to 'geometric_mean' must be a list of expressions or a matrix"))$


/* Variation coefficient */
cv(x):=block([listarith:true],std1(x) / mean(x))$


/* Mean deviation */
mean_deviation(x):=block([t,listarith:true],
   if matrixp(x)
      then (t:transpose(x),
            makelist(mean(abs(t[i]-mean(t[i]))),i,1,length(t)))
      else if listofexpr(x)
           then mean(abs(x-mean(x)))
           else error("Input to 'mean_deviation' must be a list of expressions or a matrix"))$


/* Median deviation */
median_deviation(x):=block([t,listarith:true],
   if matrixp(x)
      then (t:transpose(x),
            makelist(median(abs(t[i]-median(t[i]))),i,1,length(t)))
      else if listofexpr(x)
           then median(abs(x-median(x)))
           else error("Input to 'median_deviation' must be a list of expressions or a matrix"))$


/* Pearson's skewness */
pearson_skewness(x):=block([t,listarith:true],
   if matrixp(x)
      then (t:transpose(x),
            3*makelist((mean(t[i])-median(t[i]))/std1(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then 3*(mean(x)-median(x))/std1(x)
           else error("Input to 'pearson_skewness' must be a list of expressions or a matrix"))$


/* Quartile skewness */
quartile_skewness(x):=block([q1,q2,q3,t],
   if matrixp(x)
      then (t:transpose(x),
            makelist(quartile_skewness(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then (q1:quantile(x,1/4),
                 q2:quantile(x,1/2),
                 q3:quantile(x,3/4),
                 (q3-2*q2+q1)/(q3-q1))
           else error("Input to 'quartile_skewness' must be a list of expressions or a matrix"))$


/*       MULTIVARIATE DESCRIPTIVE STATISTICS         */


/* Covariance matrix */
cov(x):=block([n:length(x),dim,m,xi,sum],
	if not matrixp(x)
		then error("The argument is not a matrix")
		else (m:matrix(mean(x)),
		      dim:length(x[1]),
		      sum:zeromatrix(dim,dim),
		      for i:1 thru n do(
			xi:matrix(x[i]),
			sum:sum+transpose(xi).xi),
		      sum/n - transpose(m).m)  )$


/* Covariance matrix (divided by n-1). The argument x must be a matrix */
cov1(x):=block([n:length(x)], cov(x)*n/(n-1))$


/* A list of global variation measures:                                   */
/*  1) total variance                                                     */
/*  2) mean variance                                                      */
/*  3) generalized variance                                               */
/*  4) generalized standard deviation                                     */
/*  5) efective variance                                                  */
/*  6) efective standard deviation                                        */
/* The argument x must be a matrix:                                       */
/* global_variances(x,false)==> x is the covariance matrix and            */
/*                 'cov1' is not recalculated                             */
/* global_variances(x,true) or global_variances(x)==> means that x stores */
/*                 sampled data and the covariance                        */
/*                 matrix 'cov1' must be computed                         */
global_variances(x,[aredata]):=block([s,p,len,aux,out:[]],
	if matrixp(x)
		then(len:length(aredata),
		     if len<1 or aredata[1]=true
			then s:cov1(x)
			else s:x,
		     p:length(s),            /* dimension */
		     aux:matrixtrace(s),
		     out:cons(aux,out),          /* total variance */
		     out:endcons(aux/p,out),     /* mean variance */
		     aux:determinant(s),
		     out:endcons(aux,out),       /* generalized variance */
		     out:endcons(sqrt(aux),out), /* generalized standard deviation */
		     aux:aux^(1/p),
		     out:endcons(aux,out),       /* efective variance */
		     out:endcons(sqrt(aux),out)  /* efective standard deviation */
		     ),
	out)$


/* Correlation matrix. The argument x must be a matrix: */
/* cor(x,false)==> x is the covariance matrix and 'cov1'*/
/*                 is not recalculated                  */
/* cor(x,true) or cor(x)==> means that x stores sampled */
/*                 data and the covariance matrix 'cov1'*/
/*                 must be computed                     */
/* Ref. Pe~na, p.86                                      */
cor(x,[aredata]):=block([m,s,d,len],
	if matrixp(x)
		then(len:length(aredata),
		     if len<1 or aredata[1]=true
			then s:cov1(x)
			else s:x,
		     m:length(s),
		     d:sqrt(sum(ematrix(m,m,1/s[i,i],i,i),i,1,m)),
		     d.s.d)  )$


/* A list of dependence measures:                                           */
/*  1) precision matrix                                                     */
/*  2) multiple correlation                                                 */
/*  3) partial correlation                                                  */
/* The argument x must be a matrix:                                         */
/* list_correlations(x,false)==> x is the covariance matrix and             */
/*                 'cov1' is not recalculated                               */
/* list_correlations(x,true) or list_correlations(x)==> means that x stores */
/*                 sampled data and the covariance                          */
/*                 matrix 'cov1' must be computed                           */
list_correlations(x,[aredata]):=block([s,p,len,s1,d,out:[],listarith:true],
	if matrixp(x)
		then(len:length(aredata),
		     if len<1 or aredata[1]=true
			then s:cov1(x)
			else s:x,
		     p:length(s),                          /* dimension */
		     s1:invert(s),
		     d:zeromatrix(p,p),
		     for i:1 thru p do d[i,i]:1/sqrt(s1[i,i]),
		     [s1,                                  /* precision matrix */
		      1-1/makelist(s[i,i]*s1[i,i],i,1,p),  /* mult. corr. */
		      -d.s1.d]                             /* part. corr. */   ))$






/*          PLOTTING FUNCTIONS           */





/* This auxiliary function helps to separate draw and specific local options */
extract_options(s,[mo]):=
  block([ss:[],mmo:[]],
    for k in s do
      if member(lhs(k), mo)
        then mmo: endcons(k,mmo)
        else ss : endcons(k,ss),
    [ss,mmo] )$


random_color():=
  block([obase : 16, col : "#"],
    for i : 1 thru 6 do
       col : concat(col,
                    block([sz : concat(random(16))],
                          substring(sz, slength(sz)))),
    col)$


/* Plots scatter diagrams. */
scatterplot(m,[select]):=
  block([scen,localopts,nclass:10],
    [select, localopts]: extract_options(select,'nclasses),
    for k in localopts do
      if lhs(k) = 'nclasses then nclass: rhs(k),

    if listofnumbersp(m) or matrixp(m) and (length(m)=1 or length(m[1])=1)
      then  (/* m is a list of numbers or a column or a row matrix */
             if matrixp(m)
               then if length(m)=1
                      then m: m[1]
                      else m: transpose(m)[1],
             scen: append(select,
                          [points(makelist([x,0],x,m))]),
             if draw_compound
               then apply('draw2d,scen)
               else scen )
      elseif listp(m) and every('identity,map(lambda([z],listofnumbersp(z) and length(z)=2),m)) or
             matrixp(m) and length(m[1])=2 then
             /* m is a two-dimensional sample */
             (scen: append(select,[points(args(m))]),
              if draw_compound
                then apply('draw2d,scen)
                else scen)
      elseif matrixp(m) and length(m[1])>2 then
             /* m is an d-dimensional (d>2) sample */
             (scen: block([n: length(m[1]), draw_compound:false, gr],
                     gr: ['columns = n],
                     for i:1 thru n do
                       for j:1 thru n do
                         gr: endcons(if i=j
                                       then apply('gr2d,append(apply('histogram, append([col(m,i)],select,localopts))))
                                       else apply('gr2d,append(apply('scatterplot, append([subsample(m,lambda([v],true),i,j)],select)))) ,
                                     gr),
                     gr),
             if draw_compound
               then apply('draw,scen)
               else scen )
      else error("sorry, can't plot the scatter diagram for these data")) $



/* Plots histograms. Argument 'm' must be a list, a one column matrix or a       */
/* one row matrix. The second and consecutive arguments are either draw options  */
/* or the specific 'nclasses' option (10 by default) to control number of classes*/
histogram(m,[select]):=
   block([fr,amp,scen,localopts,nclass:10],
      [select, localopts]: extract_options(select,'nclasses),
      for k in localopts do
        if lhs(k) = 'nclasses then nclass: rhs(k),

      if not intergerp(nclass) or nclass < 3
        then error("histogram: number of classes must be an integer greater than two"),

      /* if m is a list of numbers or a column or a row matrix then */
      /* plots a simple histogram.                                  */
      if listofnumbersp(m) or matrixp(m) and (length(m)=1 or length(m[1])=1)
        then (/* transform input data into a list */
              if matrixp(m)
                then if length(m)=1
                       then m: m[1]
                       else m: transpose(m)[1],

               /* frequency table */
               fr: continuous_freq(m,nclass),
               amp: fr[1][2]-fr[1][1],
               scen:append(select,
                           [apply('bars,
                                  makelist([(fr[1][k]+fr[1][k+1])/2, fr[2][k], amp],k,1,nclass)),
                            'xrange = [fr[1][1]-amp/2, fr[1][nclass+1]+amp/2],
                            'yrange = lmax(fr[2])*[-0.05, 1.05]  ] ),
              if draw_compound
                then apply('draw2d,scen)
                else scen )
        else error("sorry, can't plot the histogram for these data") )$



/* Plots bar charts for discrete or categorical data, both for one or more */
/* samples.  This function admits an arbitrary number of arguments.        */
/* The first arguments are lists or matrices with sample data. The rest of */
/* arguments are options in equation format (option = value). Options can  */
/* be the same used by package draw and/or those which are specific to this*/
/* function, namely            */
/*    - box_width,             */
/*    - groups_gap,            */
/*    - bars_colors,           */
/*    - relative_frequencies,  */
/*    - ordering,              */
/*    - sample_keys            */
barsplot([args]):=
  block([lastsample: 0, nargs: length(args), drawopts, localopts,
          freqs: [], samplespace, sspacesize, nsamples, scene, totalgap,
         /* default options */
         my_box_width: 3/4, my_groups_gap: 1, my_relative_frequencies: false,
         my_ordering: 'orderlessp, my_bars_colors: [], my_sample_keys: [] ],

    /* check for data */
    for i:1 thru nargs do
      if listp(args[i]) or matrixp(args[i])
        then lastsample: lastsample + 1,

    /* check for barsplot options */
    [drawopts, localopts]: extract_options(makelist(args[k],k,lastsample + 1,nargs),
                                           'box_width, 'groups_gap, 'bars_colors,
                                           'relative_frequencies, 'ordering, 'sample_keys),
    for k in localopts do
      if lhs(k) = 'box_width
        then my_box_width: float(rhs(k))
      elseif lhs(k) = 'groups_gap
        then my_groups_gap: rhs(k)
      elseif lhs(k) = 'bars_colors
        then my_bars_colors: rhs(k)
      elseif lhs(k) = 'relative_frequencies
        then my_relative_frequencies: rhs(k)
      elseif lhs(k) = 'ordering
        then my_ordering: rhs(k)
      elseif lhs(k) = 'sample_keys
        then my_sample_keys: rhs(k),
    if my_box_width > 1 or my_box_width < 0
      then error("barsplot: illegal value for box_width"),
    if not integerp(my_groups_gap) or my_groups_gap < 1
      then error("barsplot: illegal value for groups_gap"),
    if not listp(my_bars_colors)
      then error("barsplot: illegal value for bars_colors"),
    if my_relative_frequencies # true and my_relative_frequencies # false
      then error("barsplot: illegal value for relative_frequencies"),
    if not member(my_ordering, [orderlessp, ordergreatp])
      then error("barsplot: illegal value for ordering"),
    if not (my_sample_keys = []
            or listp(my_sample_keys) and every('stringp, my_sample_keys))
      then error("barsplot: illegal value for sample_keys"),

    /* get absolute frequencies */
    for k: 1 thru lastsample do (
      if listp(args[k])
        then freqs: cons(discrete_freq(args[k]), freqs)
      elseif matrixp(args[k])
        then for c in args(transpose(args[k])) do
               freqs: cons(discrete_freq(c), freqs)
        else error("barsplot: unknown data format")),

    /* transform freqs into a more suitable form */
    samplespace: listify(setify(apply('append,map('first,freqs)))),
    samplespace : sort(samplespace, my_ordering),
    sspacesize: length(samplespace),
    nsamples: length(freqs),
    if my_sample_keys = []
      then my_sample_keys : makelist("",k,1,nsamples),
    if nsamples # length(my_sample_keys)
      then error("barsplot: incorrect number of elements in sample_keys"),
    freqs: makelist(
             makelist(
               block([pos: ?position(k,first(i))],
                    if pos = false
                       then 0
                       else second(i)[pos]),
               i, freqs),
             k,samplespace),

    /* transform to relative frequencies, if necessary */
    if my_relative_frequencies
      then block([samplesizes: apply("+",freqs)],
                 freqs: map(lambda([z], z/samplesizes), freqs)),

    /* complete my_bars_colors with random colors, if necessary */
    if nsamples > length(my_bars_colors)
      then my_bars_colors: append(my_bars_colors,
                              makelist(random_color(),k,length(my_bars_colors)+1,nsamples)),
    totalgap: nsamples + my_groups_gap,
    scene: append(drawopts,
                  ['yrange = [0, lmax(flatten(freqs)) * 1.05],
                   xtics = setify(makelist([string(samplespace[k]),
                                            (k-1)*totalgap + (nsamples+1)/2],
                                           k, 1, sspacesize))],
                  apply(append,
                        makelist(
                          [fill_color = my_bars_colors[m],
                           key = my_sample_keys[m],
                           apply('bars,
                                 makelist(
                                   block(
                                     [pos: (k-1)*totalgap + m],
                                     [pos, freqs[k][m], my_box_width]),
                                   k,1,sspacesize))],
                        m,1,nsamples)) ),

    if draw_compound
      then apply('draw2d,scene)
      else scene)$




/* Plots pie charts for discrete or categorical data. Argument 'm' must be a  */
/* list, a one column matrix or a one row matrix. The second and consecutive  */
/* arguments are either draw options or the specific 'pie_center' ([0,0] by   */
/* default) or 'pie_radius' (1 by default) options to control the center and  */
/* the radius of the diagram, respectively.                                   */
piechart(m,[select]):=
   block([fr,tot,scen,degrees,ini,end:0,alpha,hexcolor,conver:float(%pi/180),
          sectors,localopts,piecent:[0,0],pierad:1],
      [select, localopts]: extract_options(select,'pie_center,'pie_radius),
      for k in localopts do
        if     lhs(k) = 'pie_center then piecent: float(rhs(k))
        elseif lhs(k) = 'pie_radius then pierad: float(rhs(k)),

      if pierad <= 0
         then error("pie radius must be greater than zero"),
      if listofnumbersp(m) or matrixp(m) and (length(m)=1 or length(m[1])=1)
        then (/* transform input data into a list */
              if matrixp(m)
                then if length(m)=1
                       then m: m[1]
                       else m: transpose(m)[1],

               /* frequency table */
               fr: discrete_freq(m),
               tot: length(fr[1]),
               degrees: 360.0 * fr[2] / apply("+", fr[2]),
               sectors: makelist((ini: end,
                                  end: ini + degrees[i],
                                  alpha: ini+degrees[i]/2.0,
                                  hexcolor: random_color(),
                                  [/* 'color = black,
                                    label([fr[1][i],
                                           pierad*1.1*cos(alpha*conver),
                                           pierad*1.1*sin(alpha*conver)]),*/
                                    'color = hexcolor,  
                                    'fill_color = hexcolor,
                                    'key = concat(fr[1][i]),
                                    ellipse(piecent[1],piecent[2],
                                            pierad,pierad,
                                            ini,degrees[i]) ])
                                  ,i,1,tot),
               scen:append(select, flatten(sectors)),
              if draw_compound
                then apply('draw2d,scen)
                else scen )
        else error("sorry, can't plot the piechart for these data") )$



/* Plots box-whisker diagrams. Argument 'm' must be a list of numbers or a matrix. */
/* The second and consecutive arguments are either draw options or the specific    */
/* 'box_width' option (3/4 by default) to control boxes widths.                     */
boxplot(m,[select]):=
   block([fr,tot,scen,top:0,bot:inf,localopts,boxwidth:3/4],
      [select, localopts]: extract_options(select,'box_width),
      for k in localopts do
        if lhs(k) = 'box_width then boxwidth: float(rhs(k)),

      if boxwidth > 1 or boxwidth < 0
         then error("boxes width is out of range"),
      /* if m is not a row matrix, transpose it */
      if matrixp(m) and length(m)>1
         then m: transpose(m),
      /* if m is a list of numbers, transform it */
      /* to the form [[n1,n2,....]]              */
      if listofnumbersp(m) then m: [m],

      /* plot boxes */
      if listoflistsp(m) or matrixp(m)
        then(
          tot: length(m),
          scen: append(select,
                       ['points_joined = true,
                        'point_size = 0,
                        'point_type = 'dot],
                       flatten(
                         makelist(map('points,
                                      block([mi: float(smin(m[x])),
                                             ma: float(smax(m[x])),
                                             q1: float(quantile(m[x],0.25)),
                                             q2: float(quantile(m[x],0.5)),
                                             q3: float(quantile(m[x],0.75)),
                                             w:  float(boxplot_width),
                                             w2: boxwidth/2,
                                             w4: boxwidth/4,
                                             A,B,C,D,E,F,G,H,I,J,K,L,M,N],
                                        top: max(top,ma),
                                        bot: min(bot,mi),
                                        A: [x-w2,q1],     B: [x-w2,q3],     C: [x+w2,q3],
                                        D: [x+w2,q1],     E: [x-w2,q2],     F: [x+w2,q2],
                                        G: [x,q3],        H: [x,ma],        I: [x-w4,ma],
                                        J: [x+w4,ma],     K: [x,q1],        L: [x,mi],
                                        M: [x-w4,mi],     N: [x+w4,mi],
                                        [[A,B,C,D,A],[E,F],[G,H],[I,J],[K,L],[M,N]])),
                                x,1,tot)),
                       ['xtics  = setify(makelist(k,k,1,tot)),
                        'xrange = (tot-1)*0.05*[-1,+1.5]+[0.5,tot+0.5],
                        'yrange = (top-bot)*0.05*[-1,+1]+[bot,top] ] ),
              if draw_compound
                then apply('draw2d,scen)
                else scen )
        else error("sorry, can't plot the box-whisker plot for these data") )$
