/*               COPYRIGHT NOTICE

Copyright (C) 2005-2007 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: the mean
   mini: minimum value
   maxi: 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
*/



/*            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:tree_reduce('min,lis),
   lim:[mini],
   amp:(tree_reduce('max,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 */
mini(x):=block([t],
   if matrixp(x)
      then (t:transpose(x),
            makelist(mini(t[i]),i,1,length(t)))
      else if listofexpr(x)
           then tree_reduce('min,x)
           else error("Input to 'mini' must be a list of expressions or a matrix"))$


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


/* 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 tree_reduce('max,x) - tree_reduce('min,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] )$


/* 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 = tree_reduce('max,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. 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 'box_width' option (3/4   */
/*  by default) to control boxes widths.                                       */
barsplot(m,[select]):=
   block([fr,tot,scen,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 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]),
               scen:append(select,
                           [apply('bars,
                                  makelist([k, fr[2][k], boxwidth],k,1,tot)),
                            'xtics = setify(map("[", map('string, fr[1]), makelist(k,k,1,tot))),   
                            'xrange = (tot-1)*0.05*[-1,+1.5]+[0.5,tot+0.5],
                            'yrange = tree_reduce('max,fr[2])*[-0.05, 1.05] ] ),
              if draw_compound
                then apply('draw2d,scen)
                else scen )
        else error("sorry, can't plot the barsplot for these data") )$


random_color():=
  block([obase:16],
    concat("#",
           random(16),random(16),  /* red */
           random(16),random(16),  /* green */
           random(16),random(16))  /* blue */    )$


/* 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(mini(m[x])),
                                             ma: float(maxi(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") )$



/************** O L D    P L O T T I N G    F U N C T I O N S **************/

/* I have not renamed dataplot, but I have attached an extra 2 to the names of */
/* the old versions of histogram, barsplot and boxplot. Sooner or later I'll  */
/* remove these functions, since new versions take advantage of draw's options.*/

dataplot(m,[select]):=
   block([numer:true,display2d:false,options,defaults,aux,dim,ampx,ampy,x,y,fr,offs,listarith:true],

      /* updating options */
      options: ['outputdev, 'maintitle, 'axisnames, 'joined, 'picturescales, 'threedim, 'axisrot, 'nclasses, 'pointstyle],
      defaults: ["x", "", ["x","y","z"], false, [1.0, 1.0], true, [60, 30], 10, 1],

      if get(wxmaxima, version)#false then defaults[1]: "wxmaxima",

      for i in select do(
         aux: ?position(lhs(i),options),
         if numberp(aux) and aux <= length(options) and aux >= 1
            then defaults[aux]: rhs(i)),

      /* if m is a list of numbers, first components are consecutive integers */
      /* if m is a list of paired numbers, Maxima plots them.                 */
      if listofnumbersp(m) or
         matrixp(m) and length(m[1]) <= 2 then
            (with_stdout("maxout.gnuplot",
               if defaults[1] = "eps"
                  then (print("set terminal postscript eps"),
                        print("set out 'dataplot.eps'"))
                  else if defaults[1] = "png"
                          then (print("set terminal png"),
                                print("set out 'dataplot.png'"))
                  else if defaults[1] = "wxmaxima"
                          then (print(wxplot_preamble()),
                                print("set out 'dataplot.png'")),
               print("set zeroaxis"),
               print("set nokey"),
               print("set size ", defaults[5][1], ",", defaults[5][2]),
               if defaults[2] # ""
                  then print("set title \'",defaults[2],"\'"),
               if length(defaults[3]) > 1
                  then (print("set xlabel \'",defaults[3][1],"\'"),
                        print("set ylabel \'",defaults[3][2],"\'")),
               aux: length(m),
               /* offsets */
               if listofnumbersp(m)
                  then offs: [aux, range(m)]*0.05
                  else /* m is a matrix */
                       if length(m[1])=1
                          then offs: [aux, range(m)[1]]*0.05
                          else offs: range(m)*0.05,
               print("set offset", offs[1], ",", offs[1],",", offs[2],",",offs[2]),
               /* points */
               if defaults[4]
                  then print("plot '-' with lines 1")
                  else print("plot '-' with points pointtype",defaults[9]),
               if listofnumbersp(m)
                  then for i thru aux do print(i, m[i])
                  else /* m is a matrix */
                       if length(m[1])=2
                          then /* two column vector */
                               for i thru aux do print(m[i,1], m[i,2])
                          else /* one column vector */
                               for i thru aux do print(i, m[i,1])),
             if defaults[1] = "wxmaxima" then (
               callgnuplot(false),
               wxxmltag("dataplot.png", "img")
             )
             else if defaults[1] = "x" then callgnuplot(true)
             else callgnuplot(true))

      /* three column matrix with 3d plot */
      else if matrixp(m) and length(m[1])=3 and defaults[6] then
         (with_stdout("maxout.gnuplot",
            if defaults[1] = "eps"
              then (print("set terminal postscript eps"),
                    print("set out 'dataplot.eps'"))
              else if defaults[1] = "png"
                      then (print("set terminal png"),
                            print("set out 'dataplot.png'"))
              else if defaults[1] = "wxmaxima"
                       then (print(wxplot_preamble()),
                             print("set out 'dataplot.png'")),
            if 0 <= defaults[7][1] and defaults[7][1] <= 180 and
               0 <= defaults[7][2] and defaults[7][2] <= 360
               then print("set view ", defaults[7][1], ",", defaults[7][2], ",1,1"),
            print("set nokey"),
            print("set size ", defaults[5][1], ",", defaults[5][2]),
            if defaults[2] # ""
               then print("set title \'",defaults[2],"\'"),
            if length(defaults[3]) > 2
              then (print("set xlabel \'",defaults[3][1],"\'"),
                    print("set ylabel \'",defaults[3][2],"\'"),
                    print("set zlabel \'",defaults[3][3],"\'")),
            if defaults[4]
               then print("splot '-' with lines 1")
               else print("splot '-' with points pointtype",defaults[9]),
            aux: length(m),
            for i thru aux do print(m[i,1], m[i,2], m[i,3]) ),
             if defaults[1] = "wxmaxima" then (
               callgnuplot(false),
               wxxmltag("dataplot.png", "img")
             )
             else if defaults[1] = "x" then callgnuplot(true)
             else callgnuplot(false))

      /* multivariate scatterplot */
      else if matrixp(m) then 
         (with_stdout("maxout.gnuplot",
            if defaults[1] = "eps"
              then (print("set terminal postscript eps"),
                    print("set out 'dataplot.eps'"))
              else if defaults[1] = "png"
                      then (print("set terminal png"),
                            print("set out 'dataplot.png'"))
              else if defaults[1] = "wxmaxima"
                       then (print(wxplot_preamble()),
                             print("set out 'dataplot.png'")),
            print("unset key"),
            print("set size ", defaults[5][1], ",", defaults[5][2]),
            print("set origin 0.0,0.0"),
            print("set multiplot"),
            aux:length(m),
            dim:length(m[1]),
            ampx:defaults[5][1]/dim,
            ampy:defaults[5][2]/dim,
            m: transpose(m),
            offs: makelist(range(m[i]),i,1,dim)*0.05,  /* offsets 5% */
            for i:1 thru dim do
               for j:1 thru dim do(
                  x: ampx*(i-1),
                  y: ampy*(dim-j),
                  print("set size",ampx,",",ampy),
                  print("set origin",x,",",y),
                  fr: continuous_freq(m[i],defaults[8]),
                  if i=j then (   /* plot histogram */
                     print("set offsets 0, 0, 0, 0"),
                     print("plot '-' with boxes fill solid 0.3"),
                     for k:1 thru defaults[8] do
                        print((fr[1][k]+fr[1][k+1])/2,fr[2][k]) )
                  else (   /* plot cloud */
                     print("set offsets ",offs[i],",",offs[i],",",offs[j],",",offs[j]),
                     print("plot '-' with points pointtype",defaults[9]),
                     for k:1 thru aux do
                        print(m[i,k],m[j,k]) ),
                  print("e") ),
            print("unset multiplot") ),
            if defaults[1] = "wxmaxima" then (
               callgnuplot(false),
               wxxmltag("dataplot.png", "img")
            )
            else if defaults[1] = "x" then callgnuplot(true)
            else callgnuplot(false))

      else error("sorry, can't plot these data") )$


histogram2(m,[select]):=
   block([numer:true,display2d:false,options,defaults,aux,fr,amp],

      /* updating options */
      options: ['outputdev, 'maintitle, 'axisnames, 'picturescales, 'nclasses,
                'relbarwidth, 'barcolor, 'colorintensity],
      defaults: ["x", "", ["x", "Fr."], [1.0, 1.0], 10, 0.9, 1, 1],

      if get(wxmaxima, version)#false then defaults[1]: "wxmaxima",

      for i in select do(
         aux: ?position(lhs(i),options),
         if numberp(aux) and aux <= length(options) and aux >= 1
            then defaults[aux]: rhs(i)),

      /* 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
            (with_stdout("maxout.gnuplot",
               if defaults[1] = "eps"
                  then (print("set terminal postscript eps"),
                        print("set out 'histogram.eps'"))
                  else if defaults[1] = "png"
                          then (print("set terminal png"),
                                print("set out 'histogram.png'"))
              else if defaults[1] = "wxmaxima"
                  then (print(wxplot_preamble()),
                        print("set out 'dataplot.png'")),
               print("set nokey"),
               print("set size ", defaults[4][1], ",", defaults[4][2]),
               if defaults[2] # ""
                  then print("set title \'",defaults[2],"\'"),
               if length(defaults[3]) > 1
                  then (print("set xlabel \'",defaults[3][1],"\'"),
                        print("set ylabel \'",defaults[3][2],"\'")),
               print("set style fill solid", defaults[8], "border -1"),
               print("set boxwidth", defaults[6] ,"relative"),
               if matrixp(m)
                  then if length(m)=1
                          then m: m[1]
                          else m: transpose(m)[1],
               fr: continuous_freq(m,defaults[5]),
               amp: fr[1][2]-fr[1][1],
               print("set xrange [",fr[1][1]-amp/2,":",fr[1][defaults[5]+1]+amp/2,"]"),
               print("set xtics ", fr[1][1], ",", amp),
               print("set yrange [0:",tree_reduce('max,fr[2])*1.05,"]"),
               print("plot '-' with boxes lt", defaults[7]),
               for k:1 thru defaults[5] do
                        print((fr[1][k]+fr[1][k+1])/2,fr[2][k])),
             if defaults[1] = "wxmaxima" then (
                callgnuplot(false),
                wxxmltag("dataplot.png", "img")
             )
             else if defaults[1] = "x" then callgnuplot(true)
             else callgnuplot(false))

         else error("sorry, can't plot the histogram for these data") )$


barsplot2(m,[select]):=
   block([display2d:false,options,defaults,aux,fr,amp,str],

      /* updating options */
      options: ['outputdev, 'maintitle, 'axisnames, 'picturescales,
                'relbarwidth, 'barcolor, 'colorintensity],
      defaults: ["x", "", ["x", "Fr."], [1.0, 1.0], 0.9, 1, 1],

      if get(wxmaxima, version)#false then defaults[1]: "wxmaxima",

      for i in select do(
         aux: ?position(lhs(i),options),
         if numberp(aux) and aux <= length(options) and aux >= 1
            then defaults[aux]: rhs(i)),

      /* if m is a list of numbers or a column or a row matrix then */
      /* plots a simple histogram.                                  */
      if listp(m) or
         matrixp(m) and (length(m)=1 or length(m[1])=1) then
            (with_stdout("maxout.gnuplot",
               if defaults[1] = "eps"
                  then (print("set terminal postscript eps"),
                        print("set out 'barsplot.eps'"))
                  else if defaults[1] = "png"
                          then (print("set terminal png"),
                                print("set out 'barsplot.png'"))
                  else if defaults[1] = "wxmaxima"
                     then (print(wxplot_preamble()),
                        print("set out 'dataplot.png'")),
               print("set nokey"),
               print("set size ", defaults[4][1], ",", defaults[4][2]),
               if defaults[2] # ""
                  then print("set title \'",defaults[2],"\'"),
               if length(defaults[3]) > 1
                  then (print("set xlabel \'",defaults[3][1],"\'"),
                        print("set ylabel \'",defaults[3][2],"\'")),
               print("set style fill solid", defaults[7], "border -1"),
               print("set boxwidth", defaults[5] ,"relative"),
               if matrixp(m)
                  then if length(m)=1
                          then m: m[1]
                          else m: transpose(m)[1],
               fr: discrete_freq(m),
               aux: length(fr[2]),
               str: sconcat("set xtics(\"",fr[1][1],"\" ",1),
               for k:2 thru aux do
                  str: sconcat(str,", \"",fr[1][k], "\" ", k),
               print(str,")"),
               print("set xrange [0.5:",aux+0.5,"]"),
               print("set yrange [0:",tree_reduce('max,fr[2])*1.05,"]"),
               print("plot '-' with boxes lt", defaults[6]),
               for k:1 thru aux do
                  print(k, fr[2][k])),
             if defaults[1] = "wxmaxima" then (
               callgnuplot(false),
               wxxmltag("dataplot.png", "img")
             )
             else if defaults[1] = "x" then callgnuplot(true)
             else callgnuplot(false))

         else error("sorry, can't plot the bars for these data") )$


boxplot2(m,[select]):=block([numer:true,display2d:false,options,defaults,aux],

      /* updating options */
      options: ['outputdev, 'maintitle, 'axisnames,'picturescales],
      defaults: ["x", "", ["sample","y"], [1.0, 1.0]],
      
      if get(wxmaxima, version)#false then defaults[1]: "wxmaxima",

      for i in select do(
         aux: ?position(lhs(i),options),
         if numberp(aux) and aux <= length(options) and aux >= 1
            then defaults[aux]: rhs(i)),

      /* 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 be of the form [[n1,n2,....]]        */
      if listofnumbersp(m) then m: [m],

      /* plot boxes */
      if listoflistsp(m) or matrixp(m) then
         (with_stdout("maxout.gnuplot",
             if defaults[1] = "eps"
                then (print("set terminal postscript eps"),
                      print("set out 'boxplot.eps'"))
                else if defaults[1] = "png"
                        then (print("set terminal png"),
                              print("set out 'boxplot.png'"))
                else if defaults[1] = "wxmaxima"
                   then (print(wxplot_preamble()),
                      print("set out 'dataplot.png'")),
             print("set nokey"),
             print("set size ", defaults[4][1], ",", defaults[4][2]),
             if defaults[2] # ""
                then print("set title \'",defaults[2],"\'"),
             if length(defaults[3]) > 1
                then (print("set xlabel \'",defaults[3][1],"\'"),
                      print("set ylabel \'",defaults[3][2],"\'")),
             print("set boxwidth 0.5 relative"),
             aux: length(m),
             print("set xrange [0:",aux+1,"]"),
             print("set xtics ", 1, ",", 1),
             print("plot '-' using 1:3:2:5:4 with candlesticks lt 1 lw 2,",
                   " '-' using 1:2:2:2:2 with candlesticks lt 1 lw 2"),
             for i thru aux do( z:m[i],
                print(i, mini(m[i]), quantile(m[i],0.25), quantile(m[i],0.75), maxi(m[i]))     ),
             print("e"),
             for i thru aux do
                print(i, median(m[i]))),
         if defaults[1] = "wxmaxima" then (
            callgnuplot(false),
            wxxmltag("dataplot.png", "img")
         )
         else if defaults[1] = "x" then callgnuplot(true)
         else callgnuplot(false))

      else error("sorry, can't plot the box-whisker plot for these data") )$

