#!/usr/bin/env perl

#
# Copyright (C) Nicolas Thierry-Mieg, 2009.
#
#
# This 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 script 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 this script; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA


# take as argument an STD design file.
# create several partial STD design files in current dir:
# - each file has q*q*$blocsPerPart variables (starting at 0),
# - there are as many pools as in the original STD design,
# - the pools are those represented by the correct $blocsPerPart 
#   q**2-blocks,
# - variables in the $blocsToSkip last q^2-blocs of each q^3-bloc
#   are ignored.
#
# This is a variation on makePartialSTD.060908.pl. It allows to generate
# partial designs that are even more flexible.
# For example, for C. elegans we built micro-pools (ie partial designs 
# with $blocsPerPart==1) from STD.n2028.q13.k13 (which has 12 q^2-blocs),
# and used these same design files for each batch of 2028 vars.
# Therefore each batch of 2028 variables is isomorphic, and cannot be
# superposed.
# The improvement now is that we can build partials starting from
# eg STD.n15379.q13.k13 (note: 15379==169*13*7).
# Assuming $blocsToSkip=1, the 13th 169-bloc would always be skipped, 
# so that the first 2028 variables would be smart-pooled identically 
# to before, but the next 6 batches of 2028 vars would be slightly different: 
# they could still be used as is, independantly, with adequate 
# superposition for 1536 or 384 format; but they could ALSO be 
# superposed to eg the first batch of 2028 in order to obtain good 
# smart-pools of larger size (for 96 format).


use strict ;
use warnings ;


# number of q**2-blocs in a part
# for building micro-pools: $blocsPerPart = 1
# for decoding the 384 pools, use 6; for the 1536 use 2;
# for the 96, use 12 and subsequently call regroupParts.pl to
# get the real design file.
my $blocsPerPart = 6 ;

# number of q^2-blocs to skip at the end of each q^3-bloc
my $blocsToSkip = 1 ;

(@ARGV != 1) && die "need one arg: an STD design file\n" ;

my $stdFile = $ARGV[0] ;

($stdFile =~ /STD\.n(\d+)\.q(\d+)\.k(\d+)$/) 
    || die "cannot parse name of $stdFile\n" ;

my ($n,$q,$k) = ($1,$2,$3) ;
my $baseName = "STD.n$n.q$q.k$k" ;

# sanity check: $q - $blocsToSkip must be a multiple of $blocsPerPart
if ( (($q - $blocsToSkip) % $blocsPerPart) != 0)
{
    die "blocsToSkip and blocsPerPart don't work together\n" ;
}

my $outDir = "$baseName.blocsPerPart$blocsPerPart/" ;
(-e $outDir) && die "$outDir already exists, (re)move it\n" ;
system("mkdir $outDir") ;

open(INPUT, "$stdFile") || die "cannot open $stdFile for reading\n" ;

while(<INPUT>)
{
    chomp ;
    
    my @vars = split(/:/,$_) ;

    my $part = 1 ;
    my $firstVarInPart = 0 ;
    my $lastVarInPart = $blocsPerPart * $q * $q - 1;

    # number of q^3-blocs that have been completed
    my $q3blocsDone = 0 ;

    open(OUT, ">>$outDir/$baseName.part$part") || 
	die "cannot open $outDir/$baseName.part$part for appending\n"  ;
    
    while(defined(my $var = shift(@vars)))
    {
	#warn "firstInPart==$firstVarInPart, last==$lastVarInPart, var==$var\n" ;

	if ($var < $firstVarInPart)
	{
	    # var is in a bloc that must be skipped: it is in
	    # one of the $blocsToSkip last q^2-blocs of a q^3-bloc.
	    #warn "skipping var: firstInPart==$firstVarInPart, last==$lastVarInPart, var==$var\n" ;
	    next ;
	}
	
	elsif ($var <= $lastVarInPart)
	{
	    $var -= $firstVarInPart ;
	    print OUT "$var:" ;
	    # if no more vars, add newline to last part file and close
	    if (@vars == 0)
	    {
		print OUT "\n" ;
		close(OUT) ;
	    }
	}

	else
	{
	    # var is in another part (or perhaps must be skipped)
	    print OUT "\n" ;
	    close(OUT) ;
	    $part++ ;

	    # update first and last vars in current part
	    if (($var - $q * $q * $q * $q3blocsDone) < ($q - $blocsToSkip) * $q * $q)
	    {
		# we are at the border between 2 regular q^2-blocs
		# (ie we are not changing q^3-bloc)
		$firstVarInPart = $lastVarInPart + 1 ;
		$lastVarInPart += $blocsPerPart * $q * $q ;

		open(OUT, ">>$outDir/$baseName.part$part") || 
		    die  "cannot open $outDir/$baseName.part$part for appending\n";
		# put var back into @vars
		unshift(@vars, $var) ;
	    }
	    else
	    {
		# var must be skipped, as well as everyone until the next q^3-bloc
		$q3blocsDone++ ;
		$firstVarInPart = $lastVarInPart + 1 + ($blocsToSkip * $q * $q) ;
		$lastVarInPart = $firstVarInPart + $blocsPerPart * $q * $q - 1 ;
		# we only want to open OUT if there's something to put in it
		if ($firstVarInPart < $n)
		{
		    open(OUT, ">>$outDir/$baseName.part$part") || 
			die  "cannot open $outDir/$baseName.part$part for appending\n";
		}
		# if there's no-one to skip var must be put back in @vars
		($firstVarInPart <= $var) && unshift(@vars, $var) ;
	    }

	}
    }
}


