#!/bin/env perl

=pod

=head1 NAME

make.track - create input data file to recreate the Tunis workshop poster pattern in Circos

=head1 SYNOPSIS

  ./make.track [-layers 12] [-div 56] [-offset 0.25] [-len 10000] [-axisname x] 

=head1 DESCRIPTION

=head2 -layers N

Sets the number of layers in the mosaic.

=head2 -div N

Sets the number of divisions along the circumference at which a triangle can appear. 

=head2 -len N

Sets the length of the circular axis on which triangle positions are placed. This should be a large value so that the position's integer form (Circos requires that coordinates are integers) are a good approximation.

The more layers you have, the longer the axis needs to be to avoid rounding problems.

=head2 -axisname STR

The name of the axis on which coordinates will be reported. You'll need to have the same axis name in the karyotype file.

=head1 OPTIONS

=cut

use strict;
use warnings FATAL=>"all";

use Carp;
use Config::General;
use Cwd qw(getcwd abs_path);
use Data::Dumper;
use File::Basename;
use FindBin;
use Getopt::Long;
use Math::VecStat qw(sum min max average);
use Pod::Usage;
use Time::HiRes qw(gettimeofday tv_interval);
use Storable;
use lib "$FindBin::RealBin";
use lib "$FindBin::RealBin/../lib";
use lib "$FindBin::RealBin/lib";

our (%OPT,%CONF,$conf);
our @COMMAND_LINE = ("file=s",
                     "offset=f",
                     "layers=i",
                     "div=i",
                     "len=i",
                     "axisname=s",
                     "configfile=s",
                     "help",
                     "man",
                     "debug:i");
our $VERSION = 0.01;

# read and parse configuration file
_parse_config();

sub validateconfiguration {
    $CONF{debug} = 1 if exists $CONF{debug} && ! $CONF{debug};
    $CONF{div}      ||= 56;
    $CONF{len}      ||= 10000;
    $CONF{layers}   ||= 12;
    $CONF{axisname} ||= "x";
    $CONF{offset}   ||= 0;
}

#_START

open(F,">histogram.$CONF{offset}.txt");
for my $i ( 1 .. 5*$CONF{len}/$CONF{div} ) {
  my $bin   = $CONF{len}/$CONF{div}/5;
  my $start = ($i-1)*$bin;
  my $end   = $start + $bin - 1;
  printf F ("%s %d %d %f type=histogram\n",
            $CONF{axisname},
            $start,$end,
            $i % 2 ? 1 : 0.5);
}
close(F);

# Highlight track
open(F,">highlight.$CONF{offset}.txt");
for my $i ( 1 .. $CONF{len} ) {
  my $start = ($i-1);
  my $end   = $start+1;
  printf F ("%s %d %d\n",
            $CONF{axisname},
            $start,$end);
}
close(F);

################################################################
# Make the scatter plot track - these will be the triangles
# iterate across layers
open(F,">scatter.$CONF{offset}.txt");
for my $layer (1..$CONF{layers}) {

  my $id = 0;

  # iterate across divisions in this layer
  for my $i (1..$CONF{div}) {

    # odd layers - triangles at odd positions
    next if ($layer % 2) && ($i % 2);

    # even layers - triangles at even positions
    next if ! ($layer % 2) && ! ($i % 2);

    # position along axis for this division
    my $pos = ($i-1+$CONF{offset}) * $CONF{len}/$CONF{div} % $CONF{len};;

    # report a point here, the value of the point is
    # the fractional layer number and we also
    # store the two parameters "id" (unique id per layer)
    # and the layer number
    printf F ("%s %d %d %.4f id=%d,layer=%d\n",
              $CONF{axisname},
              $pos,$pos,
              1-($layer-1)/$CONF{layers},
              $id,$layer-1);
    $id++;
  }

}

#_END

# HOUSEKEEPING ###############################################################

sub _dump_config {
	printdumper(\%OPT,\%CONF);
}

sub _parse_config {
  my $dump_debug_level = 3;
  GetOptions(\%OPT,@COMMAND_LINE);
  pod2usage() if $OPT{help};
  pod2usage(-verbose=>2) if $OPT{man};
  loadconfiguration($OPT{configfile});
  populateconfiguration();	# copy command line options to config hash
  validateconfiguration(); 
  if (defined $CONF{debug} && $CONF{debug} == $dump_debug_level) {
    $Data::Dumper::Indent    = 2;
    $Data::Dumper::Quotekeys = 0;
    $Data::Dumper::Terse     = 0;
    $Data::Dumper::Sortkeys  = 1;
    $Data::Dumper::Varname = "OPT";
    printdumper(\%OPT);
    $Data::Dumper::Varname = "CONF";
    printdumper(\%CONF);
    exit;
  }
}

sub populateconfiguration {
  for my $var (keys %OPT) {
    $CONF{$var} = $OPT{$var};
  }
  repopulateconfiguration(\%CONF);
}

sub repopulateconfiguration {
  my ($node,$parent_node_name) = shift;
  return unless ref($node) eq "HASH";
  for my $key (keys %$node) {
		my $value = $node->{$key};
		if (ref($value) eq "HASH") {
			repopulateconfiguration($value,$key);
		} elsif (ref($value) eq "ARRAY") {
			for my $item (@$value) {
				repopulateconfiguration($item,$key);
			}
		} elsif (defined $value) {
			my $new_value = parse_field($value,$key,$parent_node_name,$node);
			while ($value =~ /__([^_].+?)__/g) {
				my $source = "__" . $1 . "__";
				my $target = eval $1;
				$value =~ s/\Q$source\E/$target/g;
			}
			$node->{$key} = $value;
		}
	}
}

sub parse_field {
	my ($str,$key,$parent_node_name,$node) = @_;
	# replace configuration field
	# conf(LEAF,LEAF,...)
	while ( $str =~ /(conf\(\s*(.+?)\s*\))/g ) {
		my ($template,$leaf) = ($1,$2);
		if (defined $template && defined $leaf) {
			my @leaf         = split(/\s*,\s*/,$leaf);
			my $new_template;
			if (@leaf == 2 && $leaf[0] eq ".") {
				$new_template = $node->{$leaf[1]};
			} else {
				$new_template = fetch_conf(@leaf);
			}
			$str =~ s/\Q$template\E/$new_template/g;
		}
	}
	if ($str =~ /\s*eval\s*\(\s*(.+)\s*\)/) {
		my $fn = $1;
		$str = eval $fn;
		if ($@) {
			die "could not parse configuration parameter [$@]";
		}
	}
	return $str;
}

################################################################
#
#

sub loadconfiguration {
  my $file = shift;
  if (defined $file) {
    if (-e $file && -r _) {
      # provided configuration file exists and can be read
      $file = abs_path($file);
    } else {
      confess "The configuration file [$file] passed with -configfile does not exist or cannot be read.";
    }
  } else {
    # otherwise, try to automatically find a configuration file
    my ($scriptname,$path,$suffix) = fileparse($0);
    my $cwd     = getcwd();
    my $bindir  = $FindBin::RealBin;
    my $userdir = $ENV{HOME};
    my @candidate_files = (
													 "$cwd/$scriptname.conf",
													 "$cwd/etc/$scriptname.conf",
													 "$cwd/../etc/$scriptname.conf",
													 "$bindir/$scriptname.conf",
													 "$bindir/etc/$scriptname.conf",
													 "$bindir/../etc/$scriptname.conf",
													 "$userdir/.$scriptname.conf",
													);
    my @additional_files = ();
    for my $candidate_file (@additional_files,@candidate_files) {
			#printinfo("configsearch",$candidate_file);
			if (-e $candidate_file && -r _) {
				$file = $candidate_file;
				#printinfo("configfound",$candidate_file);
				last;
			}
    }
  }
  if (defined $file) {
    $OPT{configfile} = $file;
    $conf = new Config::General(
																-ConfigFile=>$file,
																-IncludeRelative=>1,
																-IncludeAgain=>1,
																-ExtendedAccess=>1,
																-AllowMultiOptions=>"yes",
																-LowerCaseNames=>1,
																-AutoTrue=>1
															 );
    %CONF = $conf->getall;
  }
}

sub printdebug {
	my ($level,@msg) = @_;
	my $prefix = "debug";
	if (defined $CONF{debug} && $CONF{debug} >= $level) {
		printinfo(sprintf("%s[%d]",$prefix,$level),@msg);
	}
}

sub printinfo {
	print join(" ",map { defined $_ ? $_ : "_undef_" } @_),"\n";
}

sub printdumper {
	print Dumper(@_);
}

=pod 

=head1 HISTORY

=over

=item * DD Month 2012

First version.

=back 

=head1 AUTHOR

Martin Krzywinski

=head1 CONTACT

Martin Krzywinski
Genome Sciences Center
BC Cancer Research Center
100-570 W 7th Ave
Vancouver BC V5Z 4S6

mkweb.bcgsc.ca
martink@bcgsc.ca

=cut