Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Distribute locations evenly on a map

by FloydATC (Deacon)
on Nov 30, 2009 at 21:09 UTC ( [id://810270]=perlquestion: print w/replies, xml ) Need Help??

FloydATC has asked for the wisdom of the Perl Monks concerning the following question:

I'm out fishing for ideas here.

I have a hash containing data on about 200 locations on a map. These locations are not evenly distributed, they tend to clutter around a few central locations, like suburbs to a metropolis.

I use a complicated object hierarchy to manipulate the map and import/export a lot of stuff that really has no bearing on this particular problem. So, let's just say the data structure looks like this:

%sites = ( 1 => { x => 65.1231, y => 23.1512 }, 2 => { x => 64.2327, y => 17.5328 }, 3 => { x => 66.1634, y => 21.2512 }, # ... 200 => { x => 65.6231, y => 21.8924 } );

The thing is, when plotting these locations on a map, the central areas become a dense mess with a lot of empty space in between. I would like to rearrange the locations into a sort of 'grid' which guarantees a minimum space between each location, and removes any unnecessary empty space.

Guaranteeing the minimum space is relatively easy. Closing the gaps is the problem. Consider the following map with 6 locations:

XX... X.... ..... ....X ...XX

Examining %sites I would probably want to compress this to something like this:

XX. X.X .XX

For a human, this problem is trivial to solve visually but I have no idea how to do it efficiently in code. I can't help thinking that someone else must have had this problem before me, so perhaps there's a module for it?

Update: Plenty of good ideas here, I'll have to take some time to read about the different approaches suggested. Thank you :-)

-- Time flies when you don't know what you're doing

Replies are listed 'Best First'.
Re: Distribute locations evenly on a map
by blokhead (Monsignor) on Nov 30, 2009 at 23:48 UTC
    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
    Output:
    XX... X.... ..... ....X ...XX ===== XX.. X... .... ...X ..XX ===== XX. X.. ... ..X .XX ===== XX X. .. .X XX =====
    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
    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 =====
    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.........
    is squished to:
    XXX:.......XX XXXX:..XX:..X X:...XXX:.XXX XX:...XXXX:XX XXXXXXX......
    I didn't put a "south" buffer on, so the middle "island" gets squished to be adjacent to the stuff on the bottom-left.

    blokhead

Re: Distribute locations evenly on a map
by mpeg4codec (Pilgrim) on Nov 30, 2009 at 23:31 UTC
    You're butting against the relatively complex problem efficiently laying out graphs. The simplest way to approach this is using Force-based algorithms.

    Essentially, treat the locations as masses connected by damped springs. Then run what amounts to a physics simulation until the masses no longer move or some specified number of iterations is reached.

    For a pre-packaged Perl solution, I've used Graph::Layouter to good effect.

Re: Distribute locations evenly on a map
by Fletch (Bishop) on Nov 30, 2009 at 22:55 UTC

    For some reason this reminded me of quadtrees. Your "squooshing" would be removing central rows if they don't contain any points. Not a concrete answer but that's what your diagrams brought to mind.

    Update: And there seems to be a Algorithm::QuadTree on CPAN that might get you started.

    The cake is a lie.
    The cake is a lie.
    The cake is a lie.

Re: Distribute locations evenly on a map
by pklausner (Scribe) on Dec 02, 2009 at 14:04 UTC
    Automatic layout sounds like a good job for graphviz, which also does have a CPAN module. By default, it will try to find an optimal layout minimizing the distance based on the given relationship. To make that resemble the geography, you can force the coordinates of the metropolitan center nodes and then connect the branch nodes with invisible edges to their nearest core.
    Maybe the complicated object hierarchy you mention actually helps defining the edges?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://810270]
Front-paged by keszler
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (4)
As of 2024-03-28 22:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found