This reminds me of image resizing by seam carving, and I think the solution to your problem could be informed by theirs.

In their setting, they had an image and wanted to "squish" away "unimportant" parts during the resize, while maintaining the remaining image information. Their solution was to find "seams" in the image. A seam is a path between opposite edges of an image, using any combination of straight or diagonal moves (in this way, a seam is a "contiguous" strand of pixels but need not be simply a row or column). Their approach was to use a dynamic programming algorithm to find a seam whose removal would cause the least "disturbance" in an image.

Here, your solution could be even easier. You have an "image" made up of "." and non-"." pixels. You want to find and remove any horizontal or vertical seams made up of entirely "." pixels. This can also be done in a simple dynamic programming way.

#!/usr/bin/perl
use strict;

chomp( my @data = <DATA> );
$_ = [ split // ] for @data;

do {
  print_map(\@data);
  print "=====\n";
} while (remove_vert_seam(\@data));

sub remove_vert_seam {
    my $data = shift;
    my $seam;

    my $rows = $#$data;
    my $cols = $#{ $data[0] };
 
    for my $j (0 .. $cols) {
        $seam->[0][$j] = 0 if $data->[0][$j] eq ".";
    }

    # there is a seam from the top row to ($i,$j)
    # only if (i,j) has a "." and there is a seam from
    # the top row to any of (i-1,j-1), (i-1,j), (i-1,j+1)

    # if there is a seam, remember its predecessor so we
    # can trace it back.

    for my $i (1 .. $rows) {
    for my $j (0 .. $cols) {
        if ($data->[$i][$j] eq ".") {
            $seam->[$i][$j] = $j-1
                if $j-1 >= 0     and defined $seam->[$i-1][$j-1];
            $seam->[$i][$j] = $j
                if                   defined $seam->[$i-1][$j];
            $seam->[$i][$j] = $j+1
                if $j+1 <= $cols and defined $seam->[$i-1][$j+1];
        }
    }
    }

    # if there is a seam to the bottom row, trace it back
    # to the top and remove all of the cells that are visited

    for my $j (0 .. $cols) {
        if (defined $seam->[$rows][$j]) {
            my $i = $rows;
            while ($i >= 0) {
                splice @{ $data->[$i] }, $j, 1;
                ($i,$j) = ($i-1, $seam->[$i][$j]);            
            }
            return 1;
        }
    }
    return 0;
}

sub print_map {
    my $data = shift;
    for (@$data) {
        print join("", @$_), $/;
    }
}

__DATA__
XX...
X....
.....
....X
...XX
[download]

Output:

XX...
X....
.....
....X
...XX
=====
XX..
X...
....
...X
..XX
=====
XX.
X..
...
..X
.XX
=====
XX
X.
..
.X
XX
=====
[download]

It prints out the result after removing successive vertical seams, until no more can be removed.

If you applied the same approach and then went on to remove horizontal seams, you would get

XX              XX.
XX  instead of  X.X
XX              .XX
[download]

This is because the diagonal dots constitute a seam. From your example, it is possible that you have the following unwritten rule: If two X's do not start out adjacent, then they should not become adjacent as a result of seam removal. To accomplish this, you can simply add a "buffer" around the X's:

XX:..
X:...
:....
....X
...XX
=====
XX:.
X:..
:...
...X
..XX
=====
XX:
X:.
:..
..X
.XX
=====
[download]

I used ":" as the "buffer" -- You only need to add buffer space on the east & south sides of every initial "X", instead of around all sides. Adding buffer around all sides would prevent distant X's from getting squished to within 2 cells of each other. Now removing the horizontal seams as well would result in your example output.

Update: another example:

XXX:..........XX
XXXX:....XX:...X
X:.....XXX:..XXX
XX:.....XXXX:.XX
XXXXXXX.........
[download]

is squished to:

XXX:.......XX
XXXX:..XX:..X
X:...XXX:.XXX
XX:...XXXX:XX
XXXXXXX......
[download]

I didn't put a "south" buffer on, so the middle "island" gets squished to be adjacent to the stuff on the bottom-left.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.