#!/usr/bin/env perl
#
# plot-metric-quick-hack - generate plots for CSV files with metrics values
#
# $Id$

use warnings;
use strict;

use Getopt::Std;
use File::Spec::Functions qw(abs2rel rel2abs splitpath catpath);
use File::Path qw(mkpath);

my $mydir;
BEGIN { ($mydir) = ( $0 =~ m#(.*)[/\\]# ) or $mydir = '.'; }

use lib "$mydir/../share";
use Squimp::R;

my %opt;
getopts( 'h?d:p:x:t:y:T:', \%opt );

$ENV{PATH} = '/cygdrive/c/ProgramFiles/R/R-2.11.1/bin:' . $ENV{PATH};

!system("type R 2>/dev/null") or die "fatal error: cannot find R\n";

my $x      = $opt{x} // '';
my $y      = $opt{y} // '';
my $per    = $opt{p} // '';
my $sep    = $opt{t} // ',';
my $imgext = $opt{T} // 'png';

my %ext2type = (
  'bmp' => 'bmp',
  'fig' => 'xfig',
  'jpg' => 'jpeg',
  'pdf' => 'pdf',
  'png' => 'png',
  'ps'  => 'postscript',
  'wmf' => 'win.metafile'
);

my $exts = join( ', ', sort keys %ext2type );

my $imgdevtype = $ext2type{$imgext}
 or die "invalid output filetype $imgext, must be one of: $exts\n";

@ARGV or @ARGV = ('-');

grep { /^[h?]/ } keys %opt and HELP_MESSAGE();

sub HELP_MESSAGE
{
  print <<ZZ;

Usage: $0 [-x colname] [-y colname] [-t sep] [-T imgdevtype] [csvfile1 [csvfile2 [...]]

to plot the data in the given CSV file,
using the specified columns as x and y axis.

Options:

  -d directory

    the directory to output images to; if relative,
    relative to the input file directory (not the current working directory)

  -x colname

    the name of the column to be used as the x axis;
    if not specified, separate plots are created for each column as x axis

  -y colname

    the name of the column to be used as the y axis;
    if not specified, separate plots are created for each column as y axis

  -p colname

    create a separate plot per value in this column

  -t sep

    the column separator

  -T type

    the type of image to generate, given as an extension;
      must be one of: $exts

ZZ
  exit(0);
}

my $r;

foreach my $f (@ARGV)
{

  if ( $f ne '-' && ( !-e $f || !-r $f || -d $f ) )
  {
    warn "nonexistent or unusable, skipped: $f\n";
    next;
  }

  if ( !$r )
  {
    $r = new Squimp::R;
    init_plotting();
  }

  plot_with_r($f);
}

sub init_plotting
{
  $r->x( '

smalldot=20

plotxy<-function(df,x,y,devnew,outfn_tmpl)
{
  plot12(df[,c(x,y)],devnew,paste(x,"->>",y),outfn_tmpl)
}

select_or_all<-function(elt,lst)
{
  if (missing(elt))
  {
    return(lst)
  }

  if (length(which(lst==elt)) == 0)
  {
    return(lst)
  }

  c(elt)
}

plotxys<-function(df,x,y,devnew,title_tmpl,outfn_tmpl)
{
  cat("called with x =",x,", y =",y,"\n")

  for (x2 in select_or_all(x,names(df)))
  {
    for (y2 in select_or_all(y,names(df)))
    {
      outfn=sub("%y",y2,sub("%x",x2,outfn_tmpl))
      #cat("running for x =",x2,", y =",y2,"\n")
      plot12(df[,c(x2,y2)],devnew,sub("%s",paste(x2,"->>",y2),title_tmpl),outfn)
    }
  }
}

with_nonalphas_underscored<-function(x)
{
  gsub("[^a-z]", "_", tolower(x))  # perl=TRUE is *ignored*, thank you
}

plotxyps<-function(df,x,y,pername,devnew,outfn_tmpl)
{
  if (missing(pername) || pername=="")
  {
    # no grouping requested
    plotxys(df,x,y,devnew,"%s",sub("%p","",sub("%P","",outfn_tmpl)))
  }
  else if (length(which(names(df)==pername)) == 0)
  {
    cat("ignoring request to group on a nonexistent column name:", pername)
    plotxys(df,x,y,devnew,paste("%s for invalid",pername),sub("%p",pername,sub("%P","none",outfn_tmpl)))
  }
  else
  {
    # grouping requested and possible
    ign<-by(df,factor(df[,c(pername)]),function(dfp)
    {
      pervalue=dfp[1,c(pername)]
      cat("plotting for ",pername,"=",pervalue,"\n")
      plotxys(dfp,x,y,devnew,paste("%s for",pername,":",pervalue),sub("%p",pername,sub("%P",with_nonalphas_underscored(pervalue),outfn_tmpl)))
    })
  }
}

plot12<-function(df,devnew,title,outfn)
{
  x=names(df)[1]
  y=names(df)[2]

  yvalues=df[,2]

  if (!is.numeric(yvalues))
  {
    cat("skipped (due to non-numeric y)", x, "->>", y,"\n")
    return();
  }

  i=3  # fake column index, for the color picker ...
  result="failed to plot"

  # note that the x values are not being used (!!)

  try(
  {
    devnew(outfn)
    #par(adj=0)
    #par(srt=-90) # for text()
    #par(xaxt="n")  # for text()
    par(pch=smalldot)
    yrng=c(min(yvalues),max(yvalues))
    xvalues=factor(df[,1])
    xrng=c(1,length(xvalues))
    dotcex=1/length(yvalues)
    dark=hcl(h=i*360/ncol(df),c=55,l=40)
    light=hcl(h=i*360/ncol(df),c=55,l=80)
    #par(mfrow=c(1,2))  # to add the boxplot
    #plot(c(), ylim=yrng, xlim=c(1,length(yvalues)), xlab=x, ylab=y)  # empty plot
    #plot(c(), ylim=yrng, xlim=xrng, xlab=x, ylab=y)  # empty plot
    plot(df, xlab=x, ylab=y, main=title)  # nonempty plot
    #text(1:length(yvalues), 0, labels=df[,1], srt=-90, col=dark)
    #points(df, col=dark, cex=dotcex)
cat("df:",str(df),"\n")
    #points(xvalues, yvalues, ylim=yrng, col=dark, cex=dotcex)
    #points(yvalues, ylim=yrng, col=dark, cex=dotcex)
    #lines(sort(yvalues), ylim=yrng, col=light, cex=dotcex)
    #boxplot(yvalues)
    dev.off()
    result="plotted"
  })

  cat(result, x, "->>", y, "into", outfn,"\n")
}

' );
}

sub parent_dir
{
  map { my @p = splitpath($_); catpath( @p[ 0 .. $#p - 1 ] ) } @_;
}

sub plot_with_r
{
  my ($f)      = @_;
  my ($indir)  = parent_dir($f);
  my ($outdir) = abs2rel( rel2abs( $opt{d} // '.', $indir ), '.' );

  if ( !-d ($outdir) && !mkpath($outdir) )
  {
    warn "cannot create output directory $outdir, skipping $f\n";
    return -1;
  }

  my $g = do
  {
    my $finod = abs2rel( $f, $indir );
    my $finod_base = $finod =~ /^(.*)\./ ? $1 : $finod;
    rel2abs( $finod_base, $outdir );
  };

  chomp( $f = `cygpath -w "$f"` );
  $f =~ s#\\#\\\\#g;

  chomp( $g = `cygpath -w "$g"` );
  $g =~ s#\\#\\\\#g;

  my $outfn_tmpl = sprintf(
    '%s-%s-to-%s%s.%s',
    ( $g =~ /^(.*)\./ ? $1 : $g ),
    '%x', '%y', $per ? '-for-%p-%P' : '', $imgext
  );

  $r->x( '

df<-read.table("' . $f . '",header=TRUE,sep="' . $sep . '")
plotxyps(df,"' 
     . $x . '","' 
     . $y . '","' 
     . $per . '",'
     . $imgdevtype . ',"'
     . $outfn_tmpl . '")

' );
}