Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re^3: Implementation of a QuadTree and worries of a lone programmer

by eric256 (Parson)
on Nov 07, 2008 at 18:57 UTC ( [id://722270]=note: print w/replies, xml ) Need Help??


in reply to Re^2: Implementation of a QuadTree and worries of a lone programmer
in thread RFC: Implementation of a QuadTree and worries of a lone programmer

I don't understand your notation there "0:3:2:3|2:3:0:1|0:1:1:1|1:1:0:0|", but can't you draw the area with 1's as two objects one large tall one and one small tall one? (1,0)-(3,3) and (0,1)-(0,3) or of course you could split it the other way (0,1)->(3,3) and (1,0)->(3,0).


___________
Eric Hodges
  • Comment on Re^3: Implementation of a QuadTree and worries of a lone programmer

Replies are listed 'Best First'.
Re^4: Implementation of a QuadTree and worries of a lone programmer
by Xenofur (Monk) on Nov 07, 2008 at 19:13 UTC
    The notation comes from this:
    $rectangles .= "$child->{XMIN}:$child->{XMAX}:$child->{YMIN}:$child->{YMAX}|";

    As for it being condensable into two rectangles: Yes, i am aware of that. Just haven't gotten around to implementing that last bit of optimization. :)

    Reason for that being that i was only made aware of a decently fast way to do it an hour ago.

      I was looking at the QuadTree stuff and I wonder if you wouldn't be better off just using some soft of fill technique instead. I've thrown together and example, its fast and it automaticaly builds the biggest rectangles it can. I think it might be better for your needs. It is not optomized in any way and could definitly have some parts combined together, but it works nice

      #!/bin/perl use strict; use warnings; use Data::Dumper; my $grid = [[0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0], [1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0], [1,1,1,1,0,0,0,0,0,0,0,0,1,0,0,0], [1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0], [0,0,1,1,1,1,0,0,0,0,0,0,1,1,1,0], [0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], ]; sub get_area { my $sel_area = 0; my ($grid, $x1, $y1, $x2, $y2) = @_; for my $x ($x1..$x2) { for my $y ($y1..$y2) { $sel_area++ if $grid->[$x][$y] eq "1"; } } return $sel_area; } sub sel_area { my $sel_area = 0; my ($grid, $label,$x1, $y1, $x2, $y2) = @_; die unless defined $x1 and defined $y1 and defined $x2 and defined +$y2; for my $x ($x1..$x2) { for my $y ($y1..$y2) { $grid->[$x][$y] = $label; } } return $sel_area; } my ($min_x , $min_y,$max_x, $max_y) = (0,0,15,15); my $area = get_area($grid, $min_x, $min_y,$max_x, $max_y); my $sel_area = 0; sub print_grid { my $grid = shift; for my $row (@$grid) { for my $item (@$row) { print( $item eq '0' ? '.' : $item ); } print "\n"; } } print "Selected area: $area\n"; print_grid($grid); print "\n", "X" x 16, "\n\n"; my ($s_x, $s_y) = ($min_x, $min_y); my $boxes; my $l = 'a'; while ($sel_area < $area) { if ($grid->[$s_x][$s_y] eq "1") { my ($t_x,$t_y) = ($s_x, $s_y); while (1) { last if ($grid->[$t_x+1][$s_y] ne '1'); $t_x++; } while (1) { $t_y++; my ($trial_area, $real_area) = ( get_area($grid, $s_x, $s_y, $t_x, $t_y), ( ($t_x - $s_x + 1) * ($t_y - $s_y + 1) ) ); if ($trial_area < $real_area) { $t_y--; last; }; } $sel_area += get_area($grid, $s_x, $s_y, $t_x, $t_y); sel_area($grid, $l, $s_x, $s_y, $t_x, $t_y); push @$boxes, [ $s_x, $s_y, $t_x, $t_y ]; $l ++; } last if $sel_area == $area; $s_x++; if ($s_x > $max_x) { $s_x = $min_x; $s_y++; if ($s_y > $max_y) { die "Failed" } } } print_grid($grid); print "\n"; print Dumper($boxes);
      And that outputs:
      Selected area: 38 .111............ 1111............ 1111........1... 1111............ ................ ................ ................ .........1111... ...........11... ...........11... ............111. ..1111......111. ..1111.......... ................ ................ ................ XXXXXXXXXXXXXXXX .bbb............ aaaa............ aaaa........f... aaaa............ ................ ................ ................ .........dddd... ...........ee... ...........ee... ............ggg. ..cccc......ggg. ..cccc.......... ................ ................ ................ $VAR1 = [ [ 1, 0, 3, 3 ], [ 0, 1, 0, 3 ], [11, 2,12, 5 ], [ 7, 9, 7,12 ], [ 8,11, 9,12 ], [ 2,12, 2,12 ], [10,12,11,14 ] ];

      ___________
      Eric Hodges
        Well damn. Thanks a lot!

        Your solution pretty much obsoletes my QuadTree and is about 5-6 times faster WHILE being more efficient.

        One question i have though is: Why do you use references instead of actual arrays?

        Aside from that, this'll be perfect with a little bit of rewriting. There's also a way to optimize by rejecting rectangles that have a size that's smaller than a certain limit and lowering that limit when no further matches are found. Scratch that, it makes the runtime explode.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://722270]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (8)
As of 2024-04-18 16:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found