use strict;
use warnings;
use Time::HiRes qw(gettimeofday);

my $N= $#ARGV >=0 ? $ARGV[0] : 8;
my $iMax=100;
my $bPrintMatrix = $#ARGV >= 1 ? $ARGV[1] : 0;

my $g=makeMatrix($N, $iMax);
minimizeDataFlow($N, $iMax, $g, $bPrintMatrix);
print "--------------------------\n";


#------------------------------------------------------------

sub minimizeDataFlow {
  my ($N, $iMax, $aMatrix, $bPrintMatrix) = @_;
  my $iLast = $N-1;
  my $iHalf = int($N/2);
  my $iMin=$iMax*$iHalf*$iHalf;
  my $aSolution = [];
  my $iComboCount = 0;

  my $crCombo = sub {
    my @aFirst = @{shift @_};
    my %hFirst = map { $_ => 1 } @aFirst;
    my @aSecond = grep { ! exists($hFirst{$_}) } (0..$iLast);

    my $iDataFlow = calcDataFlow($aMatrix, \@aFirst, \@aSecond);
    #print "group1: <@aFirst> group2: <@aSecond> "
    #  ."dataflow=$iDataFlow min=$iMin\n";

    if ($iDataFlow < $iMin) {
      $iMin = $iDataFlow;
      $aSolution = [ \@aFirst, \@aSecond ];
    };
    $iComboCount++;
  };


  printMatrix($aMatrix) if $bPrintMatrix;

  my $t0 = [ gettimeofday ];
  visitCombos($N, $crCombo, 0);
  my $t1 = [ gettimeofday ];
  my $tLapsed = [ $t1->[0] - $t0->[0], $t1->[1] - $t0->[1] ];
  my $iLapsed = (1000000*$tLapsed->[0] + $tLapsed->[1])/1000000;
  my $aFirst = $aSolution->[0];
  my $aSecond = $aSolution->[1];

  print "Number of nodes: $N\n";
  print "Number of combinations tried: $iComboCount\n";
  print "solution: <@$aFirst> <@$aSecond>\n";
  print "dataflow: $iMin lapsed time=$iLapsed s\n";
}

#------------------------------------------------------------

sub visitCombos {
  my ($N, $crCombo, $bPermutation) = @_;
  $bPermutation = 1 unless defined($bPermutation);
  my $iLast = $N-1;
  my $iHalf=int($iLast/2);
  my @aCombo;
  my $iCombo=0;
  my $i=0;
  my $aNext = [];
  my $hUsed={};

  for (0..$iHalf) { $aNext->[$_]=0; };
  while (1) {
    # find next value for combo element $i
    # if there are no more values left at $i, go back 1.

    my $iChosen = $aNext->[$i];
    my $iMinChosen;

    if ($bPermutation) {
      while (exists $hUsed->{$iChosen}) { $iChosen++ };
    } else {
      $iMinChosen = $i ? $aNext->[$i-1] : 0;
      $iChosen = $iMinChosen if ($iChosen < $iMinChosen);
    }
    my $iLastForI= $i ? $iLast : 0;
    #print "last: $iLastForI\n";

    while ($iChosen > $iLastForI) {
      return unless ($i > 0);
      $aNext->[$i] = 0;
      $i--;
      $iChosen = $aNext->[$i];
      $iLastForI=$i ? $iLast :0;
      #print "last: $iLastForI\n";

      if ($bPermutation) {
        delete $hUsed->{$iChosen - 1};
        while (exists $hUsed->{$iChosen}) { $iChosen++ };
      } else {
        $iMinChosen = $i ? $aNext->[$i-1] : 0;
        $iChosen = $iMinChosen if ($iChosen < $iMinChosen);
      }
    }

    # set combo element at position $i
    $aCombo[$i]=$iChosen;
    $hUsed->{$iChosen} = 1 if $bPermutation;
    $aNext->[$i] = $iChosen + 1;

    # if more elements are needed, advance to next element
    if ($i < $iHalf) { $i++; next; };

    # process completed combo
    &$crCombo(\@aCombo);

    # all elements have been assigned, move onto the next
    # combination
    delete $hUsed->{$iChosen};
  }
}

#------------------------------------------------------------

sub calcDataFlow {
  my ($aRows, $aGroup1, $aGroup2) = @_;
  my $iDataFlow=0;
  for my $x (@$aGroup2) {
    for my $y (@$aGroup1) {
      my $aRow=$aRows->[$x];
      $iDataFlow += $aRows->[$x][$y];
    }
  }
  return $iDataFlow;
}

#------------------------------------------------------------

sub makeMatrix {
  my ($N, $iMax) = @_;
  my $iLast=$N-1;
  my @f;

  #creates NxN matrix with cells where row=col undefined
  for my $x (0..$iLast) {
    for my $y ($x+1..$iLast) {
      $f[$x][$y]=$f[$y][$x]=int(rand($iMax));
    }
  }
  $f[$iLast][$iLast]=undef;  #force addition of row=col=$N

  return \@f;
}

#------------------------------------------------------------

sub printMatrix {
  my ($g) = shift;
  for (@$g) {
    my $sRow = join
      (' ', map { sprintf("%2s", defined($_) ? $_ : '-')} @$_);
    print "$sRow\n";
  }
}
[download]