#!/usr/bin/perl
#  POTM ENTRY: MoveMoveMove
#  Name:       Alex huysegoms
#  Email:      alex.huysegoms@belgacom.net
#  Update of my entry. Programmed in PERL.




# ------------
# Parameters
# ------------
$maxtime = 580;  # Max runtime in seconds
$trace   = 0;    # Generate messages?


# --------
# Inits
# --------
$starttime = time();
$timelimit = time() + $maxtime;


# ---------------------------------------------------------
# Read input file.
# The contents is saved in array @suitcase, line by line
# ---------------------------------------------------------
if (defined $ARGV[0]) { $in = $ARGV[0] }
else { $in = substr($0, 0, rindex($0, ".")).".ini" };
open(INPUTFILE,"<$in") || die "Cannot open inputfile $in";
@suitcase = <INPUTFILE>;
close(INPUTFILE);
chomp @suitcase;


# -----------------------------
# Make some general variables
# -----------------------------
@bestmoves = ();                                                 # Container for the best solution
%objects = ();                                                   # Container for all object definitions
$maprows  = scalar(@suitcase);                                   # Total rows in the map
$mapcols  = index($suitcase[0],' ');                             # Total columns in the map
$mapcells = $maprows * $mapcols;                                 # Total number of cells


# -----------------------------------------------
# Define object X
#  => $object{'X'} = 'NrOfRows NrOfColumns Size'
# -----------------------------------------------
$Xcols = rindex($suitcase[0],'X') - index($suitcase[0],'X') + 1; # Total rows of X object
for ($i=0; $i < $maprows; $i++) {                                # Total columns of X object
  if ($suitcase[$i] =~ /X/) { $Xrows = $i + 1 };
};
$trace && print "Object X is $Xrows by $Xcols cells\n";
$object{'X'} = "$Xrows $Xcols ".$Xrows*$Xcols;                   # Create object definition


# ---------------------------------------------------------
# Define all other objects.
#  => $object{'name'} = 'NrOfRows NrOfColumns Size'
#  example: $object{'A'} = '4 2 8'
# ---------------------------------------------------------
# Get all defined object names (A,B,C,...)
for ($i=0; $i < $maprows; $i++) {
  for ($j=0; $j < $mapcols; $j++) {
    $char = substr($suitcase[$i],$j,1);
    # If object not already known, set it's value to it's position: 'row column'
    if ($char =~ /[A-T]/ and !defined($object{$char})) { $object{$char} = ($i+1)." ".($j+1) };
  };
};
# Get the number of rows & columns for each of these objects
foreach my $name (keys %object) {
  my ($row,$col) = split(' ',$object{$name});                                      # Position is known
  #$_ = $suitcase[$row-1];
  my $cols = rindex($suitcase[$row-1],$name) - index($suitcase[$row-1],$name) + 1; # Get width of object
  my $rows = 0;
  foreach my $line (@suitcase) {if ($line=~/$name/) {$rows++}};                    # Get height of object
  $object{$name} = "$rows $cols ".$rows*$cols;                                     # Create object definition
};
# Make a general string-variable: all the existing objects (except the X object)
$objects = keys %object;
$objects =~ tr/X//;


# ---------------------------------------------------------------------------------------------------
#  A suitcase is known here as a 'map'.
#  A map is physically a string, where each character is a cell of the suitcase.
#  Reason: - minimal space requirements
#          - fast and easy comparison of maps, using the ordinary 'eq' operator
#          - fast and easy overlaying of maps, using the bitwise '|' and '&' operator
# ---------------------------------------------------------------------------------------------------


# --------------------------------------------------------------------------
# Create a map, consisting of only the characters 0x00 ( chr(0) or \0 )
# and another one with only the characters 0xFF  ( chr(255) )
# --------------------------------------------------------------------------
$map_empty = chr(0) x $mapcells;
$map_full  = chr(255) x $mapcells;


# -----------------------
# Create the initial map
# -----------------------
foreach $line (@suitcase) { $line = substr($line,0,$mapcols) };  # Remove everything outside of the real suitcase
$map_initial = join('',@suitcase);                               # Transform the map to a string
$map_initial =~ tr/_/\0/;                                        # Translate all '_' to the NULL character


# ------------------------------------------
# Display the initial map and the X-object
# ------------------------------------------
if ($trace) {
  print "\nInitial map:\n";
  &DisplayMap($map_initial);
  print "\nObject to insert:\n";
  &DisplayMap(&PlaceObject($map_empty,1,1,'X'));
};


# -----------------------------------------------------------------
# Check if there are enough free cells available for the X-object
# -----------------------------------------------------------------
$_ = $map_initial;
$free = tr/\0/\0/;                                               # Number of empty cells (empty = '\0')
($r,$c,$size) = split(' ',$object{'X'});                         # Number of cells in the X-object
if ($size > $free) {
  $trace && print "Not enough space. No match!\n";
  &PgmOutput("NO SOLUTION");
  exit;
};


# ------------------------------------------------------------
# Maybe object X already fits in the map, you never know!
# ------------------------------------------------------------
$at ='';                     # No position specified => subroutine will scan the compete map for a fit
if (&ObjectFit($map_initial,'X',$at)) {
  $trace && print "Object already fits at $at\n";
  &PgmOutput("X $at");
  exit;
};


# -----------------------------------------------------------------------------------
# Strategy: We create a list of maps, in each of which we will try to insert the
#           X object on a specific position.
#           On each of these maps we try to clear the area needed for insertion: each
#           object that has cells in the area has to be moved elsewhere in the map.
#           The selection of the objects to remove is based on a sequence of characters
#           in a string (see further).
#           The maps are all treated simultaniously: one object move in
#           all maps, then another in all maps, ...etc.
#           If a solution is found, it's saved in @bestmoves, unless there was
#           already a better solution (with less or equal number of moves).
#           When a solution is found for a map, we start all over again for this one,
#           to try to find a better solution. The only thing that is changed is the
#           sequence in which objects are selected for removal.
#           We continue doing this until the timeout is reached => mostly the
#           program will run until timed out. The only case where we stop before
#           timeout is a solution with 2 moves (1 move is already tested before).
#
# Actions:
#
#   Create a list '@activemap' of hashes '%map_r_c'.
#       where r = the row where we try to put the X object
#             c = the column where we try to put the X object
#   Each hash is filled with some elements:
#    - the map to work in: 'current'
#    - 2 maps that can be used for masking:
#        'mask00' -> all cells are character(0xFF); area to clear is character(0x00)
#        'maskFF' -> all cells are character(0x00); area to clear is character(0xFF)
#    - the position of the area to clear:  'targetposition' = 'row-col'
#    - the objects failed to remove: 'failedremove', initialized as ''
#    - the order in which objects are to be selected while trying to free the area:
#        'objectremovesequence'  initialized as 'ABCDE...'
#    - the moves done up to now:  'moves' = 'object row-col, object row-col, ...'
#    - the objects already used for reorganization: 'reorganized', initialized as ''
#    - status of this map:  'status' = 0 -> Cannot remove any more object from the target area.
#                                             In this case the map should be reorganized by moving
#                                             other objects than those in the target area.
#                                      1 -> Still able to remove objects from the target area.
#                                      2 -> Cannot reorganize or best number of moves already
#                                             exceeded. Restart from scratch, but with another
#                                             sequence for object selection.
#                                      3 -> A solution is found. Restart from scratch with
#                                             another sequence for object selection.
#
# ------------------------------------------------------------------------------------
@activemap = ();
for ($r=1; $r <= ($maprows-$Xrows+1); $r++) {                       # For each cell in the map
  for ($c=1; $c <= ($mapcols-$Xcols+1); $c++) {

    # Definition of local variables
    my $tempmap;
    my $FFchar  = chr(255);
    my $NULchar = chr(0);
    my $mapname = "map\_$r\_$c";                                    # Name of this map

    # Create the map to work in
    ${$mapname}{'name'} = $mapname;                                 # Name of the map
    ${$mapname}{'current'} = $map_initial;                          # 'The' map

    # The position ($r,$c) of the area to clear
    ${$mapname}{'targetposition'} = "$r-$c";

    # Create a map 'maskFF'
    $tempmap = &PlaceObject($map_empty,$r,$c,'X');                  # Place object 'X' in a map with char's '0x00'
    $tempmap =~ s/X/$FFchar/g;                                      # Change the char 'X' to char '0xFF'
    ${$mapname}{'maskFF'} = $tempmap;

    # Create map 'mask00'
    $tempmap = &PlaceObject($map_full,$r,$c,'X');                   # Place object 'X' in a map with char's '0xFF'
    $tempmap =~ s/X/$NULchar/g;                                     # Change the char 'X' to char '0x00'
    ${$mapname}{'mask00'} = $tempmap;

    # The moves done up to now, initialized as an empty string
    ${$mapname}{'moves'} = '';

    # The order of selection when trying to remove objects, initialized as 'ABCDE...'
    ${$mapname}{'objectremovesequence'} = join('',sort(keys %object));
    ${$mapname}{'objectremovesequence'} =~ s/X//;  # Remove X object

    # The objects that failed to get removed from the area up to now
    ${$mapname}{'failedremove'} = '';

    # The objects already used in a reorganization
    ${$mapname}{'reorganized'} = '';

    # The status of this map
    ${$mapname}{'status'} = 1;

    # Push a reference to this hash into the array @activemap
    push(@activemap,\%{$mapname});
  };
};


# ------------------------------------------------------------------------------
#                                 -  Go ! -
# ------------------------------------------------------------------------------

do {                                                                 # Do until timeout reached
  $looptime = time();                                                # Save for calculation of looptime

  foreach $map (@activemap) {                                        # Treat the maps one by one

    if ($trace) {print "\nProcessing $$map{'name'}\n"};

    do {
      #--------------------------------------------------------------------------
      # Can the X object be inserted now ?
      # If yes: - save the moves if they are better than the best
      #         - set the status of the map = 3 ('restart from the beginning')
      # If no, and number of moves > number of best moves: set map status = 3
      #--------------------------------------------------------------------------
      if ($trace) {print "Checking for insertion of object X\n"};
      # Use maskFF to extract only the cells in the target area
      if (($$map{'current'} & $$map{'maskFF'}) eq $map_empty ) {
        if ($trace) {print "The area is cleared!\n"};
        # Add the insertion of object X as a 'move' in the output
        #my @moves = (split("\n",$$map{'moves'}),"X ".$$map{'targetposition'}."\n");
        my @moves = (split("\n",$$map{'moves'}),"X ".$$map{'targetposition'});
        if ($trace) {print "a solution: ".@moves." -> ".join(' ',@moves)."\n"};
        # Save this solution if it's better than the best up to now
        if (!scalar(@bestmoves)) {@bestmoves = @moves; $$map{'status'} = 3}
        elsif (scalar(@moves) < scalar(@bestmoves)) {$$map{'status'} = 3; @bestmoves = @moves}
        else {$$map{'status'} = 3};
      }
      else {
        if ($trace) {
          print "Area is not cleared yet\n";
          print "    Area to clear:\n";
          &DisplayMap($$map{'maskFF'} & $$map{'current'});
          print "    Current map:\n";
          &DisplayMap($$map{'current'});
          print "\n";
        };
        # Restart from scratch if the number of moves already exceeds the best found solution.
        # Skip if no solution found up to now.
        if (@bestmoves) {
          my $moves = $$map{'moves'} =~ tr/\n/\n/;
          my $maxmoves = scalar(@bestmoves);
          if ($trace) {print("$moves moves for $$map{'name'} up to now: \n$$map{'moves'}\n")};
          if ($moves >= $maxmoves) {
            $$map{'status'} = 3;
            if ($trace) {print("Best solution has $maxmoves moves. Setting map for a restart.\n")};
          };
        };
      };
    };

    if ($$map{'status'} == 1) {                                     # Continue to remove objects from the target area
      #----------------------------------------------------
      # Get list of objects to remove from the target area
      #----------------------------------------------------
      my $objectstoremove = $$map{'current'} & $$map{'maskFF'};     # Select cells in target area
      $objectstoremove =~ s/\0//g;                                  # Remove all nulls
      if ($trace) {print "Objects to remove: $objectstoremove\n"};
      my $moved = 0;                                                # Initialize switch: nothing moved here yet
      do {                                                          # Do until something moved or unable to continue
        #-------------------------------------------------------------
        # Select an object to be removed from the target area
        #-------------------------------------------------------------
        my $objecttoremove = '';
        foreach my $obj (split('',$$map{'objectremovesequence'})) { # Objects are selected in a fixed order
          if ($objecttoremove ne '') {}                             # Skip if an object is already selected
          elsif ($objectstoremove =~ /$obj/ && $$map{'failedtoremove'} !~ /$obj/) {$objecttoremove = $obj};
        };
        if ($objecttoremove eq '') {
          #-------------------------------------------------
          # All objects have been tried in the target area
          #-------------------------------------------------
          $$map{'status'} = 0;                                      # Status 0 = map is to be reorganized
          if ($trace) {print "Cannot remove any more object from the target area. Reorganization is needed.\n"}
        }
        else {
          #-----------------------------------------------------
          # Try to move that object elsewhere, out of the area
          #-----------------------------------------------------
          if ($trace) {print "Trying to remove object $objecttoremove\n"};
          my $position;
          # Test if object fits somewhere else in the current map
          if (&ObjectFit($$map{'current'} | $$map{'maskFF'},$objecttoremove,$position)) {
            # Get the position where it fits
            my ($r,$c) = split('-',$position);
            # Move that object
            $$map{'current'} = &MoveObject($$map{'current'},$r,$c,$objecttoremove);
            $$map{'moves'} .= "$objecttoremove $position\n";
            $moved = 1;
            if ($trace) {
              print "Object $objecttoremove moved to $r\-$c\n";
              &DisplayMap($$map{'current'});
            };
          }
          else {
            # Add to the list of objects that cannot be moved
            if ($trace) {print "Unable to move object $objecttoremove\n"};
            $$map{'failedtoremove'} .= $objecttoremove;
          };
       };
      } until ($moved or $$map{'status'}==0) ;
    }

    elsif ($$map{'status'} == 0) {
      #-----------------------------------------------------------
      # The map has to be reorganized
      # => try to move objects located outside of the target area
      #-----------------------------------------------------------
      my $move = ' ';
      if ($trace) {print "This map is to be reorganized.\n"};
      if (&Reorganize($$map{'current'} | $$map{'maskFF'},$move,$$map{'reorganized'},$$map{'objectremovesequence'})) {
        my ($obj,$r,$c) = split(/[ -]/,$move);
        if ($trace) {print "Move $obj to $r,$c for reorg\n"};
        $$map{'current'} = MoveObject($$map{'current'},$r,$c,$obj);  # Update current map
        $$map{'status'} = 1;                                         # Set status: 'try to clear area'
        $$map{'moves'} .= $move."\n";                                # Add to list of moves, done up to now
        $$map{'reorganized'} .= $obj;                                # Add to list
        $$map{'failedtoremove'} = '';                                # Reset
      }
      else {
       if ($trace) {print "Cannot reorganize.\n"};
       $$map{'status'} = 2;
      };
    }

    elsif ($$map{'status'} == 2) {
      #------------------------------------------------------------
      # Unable to reorganize
      # => Restart from the beginning, but use another sequence
      #    in the selection of objects to remove
      #------------------------------------------------------------
      if ($trace) {print "This map could not be reorganized. Restarting from scratch\n"};
      $$map{'status'} = 1;
      $$map{'current'} = $map_initial;
      # Get a random character from the string (but not the first one)
      my $item = substr($$map{'objectremovesequence'},int(rand(length($$map{'objectremovesequence'}))) + 1,1);
      # Remove that character from the string
      $$map{'objectremovesequence'} =~ s/$item//;
      # Put that character in front
      $$map{'objectremovesequence'} = $item . $$map{'objectremovesequence'};
      if ($trace) {print "New object remove sequence: $$map{'objectremovesequence'}\n"};
      $$map{'failedremove'} = '';
      $$map{'reorganized'} = '';
      $$map{'moves'} = '';
    }

    elsif ($$map{'status'} == 3) {
      #---------------------------------------------------------------
      # A solution was found. Restart from scratch, but with another
      # sequence in the selection of objects to remove
      #---------------------------------------------------------------
      if ($trace) {print "Restarting from scratch for this map\n"};
      $$map{'status'} = 1;
      $$map{'current'} = $map_initial;
      # Get a random character from the string (but not the first one)
      my $item = substr($$map{'objectremovesequence'},int(rand(length($$map{'objectremovesequence'}))) + 1,1);
      # Remove that character from the string
      $$map{'objectremovesequence'} =~ s/$item//;
      # Put that character in front
      $$map{'objectremovesequence'} = $item . $$map{'objectremovesequence'};
      if ($trace) {print "New object remove sequence: $$map{'objectremovesequence'}\n"};
      $$map{'failedremove'} = '';
      $$map{'reorganized'} = '';
      $$map{'moves'} = '';
    };
  };

  if (scalar(@bestmoves) == 2) {&PgmOutput(@bestmoves)};           # 2 moves is always the best solution

  $looptime = time() - $looptime;                                  # Calculate the time needed for a loop

} until time() + $looptime > $timelimit;                           # Terminate when running out of time


if ($trace) {print "Timeout reached. Total runtime = ".(time() - $starttime)."\n"};

if (scalar(@bestmoves)) {&PgmOutput(@bestmoves)} else {&PgmOutput("NO SOLUTION")};

exit;


# ---------  S u b r o u t i n e s --------------------

sub MoveObject {
  my $map        = shift;
  my $torow      = shift;
  my $tocol      = shift;
  my $objectname = shift;
  my $rows       = shift;
  my $cols       = shift;
  # Delete object from map
  $map =~ s/$objectname/\0/g;
  # Insert the object on the new location
  return(&PlaceObject($map,$torow,$tocol,$objectname,$rows,$cols));
}

sub PlaceObject {
  my $map        = shift;
  my $rowpos     = shift;
  my $colpos     = shift;
  my $objectname = shift;
  my $rows       = shift;
  my $cols       = shift;
  my ($i,$stringpointer);
  unless (defined($rows)) { ($rows,$cols) = split(' ',$object{$objectname}) };
  for ($i=$rowpos; $i <= ($rowpos + $rows - 1); $i++) {
    $stringpointer = ($i-1)*$mapcols + $colpos;
    substr($map,$stringpointer-1,$cols) = $objectname x $cols;
  };
  return($map);
}

sub DisplayMap {
  my $map = shift;
  my $i;
  my $a = chr(0);    $map =~ s/$a/\-/g;
  my $b = chr(255);  $map =~ s/$b/1/g;
  print '+' x ($mapcols+2) . "\n";
  for ($i=1; $i <= $maprows; $i++) {
    print "+" . substr($map,($i-1)*$mapcols,$mapcols)."+\n";
  };
  print '+' x ($mapcols+2) . "\n";
  return;
}

sub ObjectFit {
  #---------------------------------------------------------------------
  # Check if an object fits in a given map.
  #  If position is given (as third argument): checks for that position.
  #  If not, tries to fit in the whole map and sets the third argument
  #    to the position where it fits best (= minimal adjacent blanc cells).
  # Return value: 0=no fit  1=ok
  #---------------------------------------------------------------------
  my $map            = $_[0];
  my $objectname     = $_[1];
  my ($i,$r,$c);
  my $workmap;
  my ($rows,$cols) = split(' ',$object{$objectname});
  if ($_[2] ne '') {
    ($r,$c) = split('-',$_[2]);
    $workmap = &PlaceObject($map_empty,$r,$c,$objectname);
    if ( ($map & $workmap) eq $map_empty ) { return(1) };
  }
  else {
    if ($trace) {print "Searching a location for $objectname\n"};
    my $bestscore = 9999;
    my $bestfit = '';
    for ($r=1; $r <= ($maprows-$rows+1); $r++) {
      for ($c=1; $c <= ($mapcols-$cols+1); $c++) {
        # Create an empty map with only the object on that position
        $workmap = &PlaceObject($map_empty,$r,$c,$objectname);
        # Test: object fits in that position?
        if ( ($map & $workmap) eq $map_empty ) {
          # Window around target position
          my ($window_r, $window_c, $window_rows, $window_cols) = ($r - 1, $c - 1, $rows + 2, $cols + 2);
          if ($window_r == 0) {$window_r = 1; $window_rows = $window_rows - 1};
          if ($window_c == 0) {$window_c = 1; $window_cols = $window_cols - 1};
          if ($window_c + $window_cols - 1 > $mapcols) {$window_cols = $window_cols - 1};
          if ($window_r + $window_rows - 1 > $maprows) {$window_rows = $window_rows - 1};
          # Window = all FF with an area of 00
          my $window = &PlaceObject($map_full,$window_r,$window_c,chr(0),$window_rows,$window_cols);
          $window = $window | $workmap;   # Place the object in the target position
          my $localmap = $map;
          $localmap =~ s/$objectname/\0/;   # Copy of current map, with object removed from original position
          $window = $window | $localmap;    # All char 0xFF, except in window
          my $score = $window =~ tr/\0/\0/; # Count number of blancs in that window
          if ($trace) {print "score = $score at $r-$c\n"};
          if ($score < $bestscore){ $bestscore = $score; $bestfit = "$r-$c" };
        };
        if ($bestscore == 0) {
          $_[2] = $bestfit;
          if ($trace) {print "Found a good place at $bestfit with score $bestscore.\n" };
          return(1);
        };
      };
    };
    if ($bestfit eq '') {return(0)}
    else {
      $_[2] = $bestfit;
      if ($trace) {print "Found a place at $bestfit with score $bestscore\n" };
      return(1);
    };
  };
}


sub Reorganize {
  # Try to move an object elsewhere
  my $map = $_[0];
  my $removesequence = $_[3];
  my $usedobjects = $_[2];
  my ($obj,$at);
  foreach $obj (split('',$removesequence)) {
    if ($usedobjects =~ /$obj/) {
      if ($trace) {print "Reorg: already tried with $obj. Skipping...\n"}
    }
    elsif ($obj eq 'X') {}
    else {
      if ($trace) {print "Reorg: trying object $obj\n"};
      if (ObjectFit($map,$obj,$at)) {
       $_[1] = "$obj $at";
       $_[2] .= $obj;
       if ($trace) {print "Fits at $at\n"};
       return(1)
      }
      else {
       if ($trace) {print "No fit\n"};
      };
    };
  };
  return(0);
}


sub PgmOutput {
  if ($trace) {print "\n--------------------\n"};
  if ($trace) {print "Program output:\n"};
  foreach my $item (@_) { print "$item\n" };
  if ($trace) {print "--------------------\n"};
  exit;
}