Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Perl Spots

by YuckFoo (Abbot)
on Aug 13, 2002 at 20:47 UTC ( [id://189941]=CUFP: print w/replies, xml ) Need Help??

Sometimes I use Perl to generate cheesy graphics to visualize math or geometry concepts. The latest effort was rather pleasing despite the cheese so I offer it here.

This program calculates and displays Voronoi neighborhoods. The neighborhoods wrap so the image (if it were one) is tileable. There are many examples of Voronoi spots found in nature, quite an interesting subject (search Google).

Any suggestions for a better @CHARS to use?

SpotFoo

#!/usr/bin/perl use strict; my @CHARS = split('', ' .,-+*$&#@'); my ($XMIN, $XMAX) = qw(0 1); my ($YMIN, $YMAX) = qw(0 1); my ($ROWS, $COLS) = qw(40 80); my $POINTS = 8; my $REPEAT = 0; my $xfact = ($XMAX - $XMIN) / $COLS; my $yfact = ($YMAX - $YMIN) / $ROWS; my (@screen, @xs, @ys); # Pick some random points for (0..$POINTS-1) { my ($xrand, $yrand) = (rand(), rand()); for my $xoffset (-1..1) { for my $yoffset (-1..1) { push (@xs, $xrand + $xoffset); push (@ys, $yrand + $yoffset); } } } # Calculate screen for my $yi (0..$ROWS-1) { my $y = $YMIN + $yi * $yfact; for my $xi (0..$COLS-1) { my $x = $XMIN + $xi * $xfact; my ($best, $good) = closest($x, $y, \@xs, \@ys); $screen[$xi][$yi] = $CHARS[int(10 * ($best / $good))]; } } # Print screen for (0..$REPEAT) { for my $yi (0..$ROWS-1) { for my $xi (0..$COLS-1) { print "$screen[$xi][$yi]"; } print "\n"; } } #----------------------------------------------------------- sub closest { my ($x, $y, $xs, $ys) = @_; my ($dist, $best, $good); for (my $i = 0; $i < @$xs; $i++) { $dist = sqrt(($x - $xs->[$i])**2 + ($y - $ys->[$i])**2); if ($i == 0 || $dist < $best) { ($good, $best) = ($best, $dis +t); } elsif ($i == 1 || $dist < $good) { $good = $dist; } } return ($best, $good); }

Replies are listed 'Best First'.
Re: Perl Spots
by hossman (Prior) on Aug 14, 2002 at 07:00 UTC
    very cool.

    A few alterations to use GD, a bit of randomness in the number of points, and it makes a sweet Eterm background generator.

    It takes a little while of course, since it's plotting a pixel at a time, but the good news is: it's perfectly tile-able

    #!/usr/bin/perl use strict; use GD; my $numColors = 128; my $size = 200; my ($XMIN, $XMAX) = qw(0 1); my ($YMIN, $YMAX) = qw(0 1); my $POINTS = 3 + int(rand(6)); my $xfact = ($XMAX - $XMIN) / $size; my $yfact = ($YMAX - $YMIN) / $size; # allocate some colors my @colors; my $img = new GD::Image($size, $size); for (my $i = 0; $i < $numColors; $i++) { push @colors, $img->colorAllocate(1, 1, $i * (256 / $numColors)); } my (@xs, @ys); # Pick some random points for (1..$POINTS) { my ($xrand, $yrand) = (rand(), rand()); for my $xoffset (-1..1) { for my $yoffset (-1..1) { push (@xs, $xrand + $xoffset); push (@ys, $yrand + $yoffset); } } } # Calculate screen for (my $yi = 0; $yi < $size; $yi++) { my $y = $YMIN + $yi * $yfact; for (my $xi = 0; $xi < $size; $xi++) { my $x = $XMIN + $xi * $xfact; my ($best, $good) = closest($x, $y, \@xs, \@ys); $img->setPixel($xi, $yi, $colors[int($numColors * ($best / $good))]); } } binmode STDOUT; print $img->png(); sub closest { my ($x, $y, $xs, $ys) = @_; my ($dist, $best, $good); for (my $i = 0; $i < @$xs; $i++) { $dist = sqrt(($x - $xs->[$i])**2 + ($y - $ys->[$i])**2); if ($i == 0 || $dist < $best) { ($good, $best) = ($best, $d +ist); } elsif ($i == 1 || $dist < $good) { $good = $dist; } } return ($best, $good); }
      Thanks for the extension hossman++. This works pretty good. Only problem is, I gave you a very sub-optimal algorithm. Ok for 40 x 80, too slow for 200 x 200.

      The big kludge was adding 8 points in adjacent squares. This isn't necessary. Instead calculate the x and y distances separately. If a distance is greater than .5, adjust it to 1 - distance. If a point is .7 from a v-point, it is .3 from a corresponding v-point in an adjacent square.

      This means about 90% fewer v-points to test against, so this is many times faster.

      So here's another version based on your changes with an additional color option.

      YuckFoo

      #!/usr/bin/perl use strict; use GD; my $ROWS = 200; # number of rows my $COLS = 200; # number of columns my $POINTS = 12; # number of Voronoi points my $COLORS = 128; # number of colors my $INNER = [255, 255, 0]; # inner color (red, green, blue) my $OUTER = [ 0, 32, 0]; # outer color (red, green, blue) my $xfact = 1 / $COLS; my $yfact = 1 / $ROWS; # Allocate some colors my $img = new GD::Image($COLS, $ROWS); my $colors = makecolors($img, $COLORS, $INNER, $OUTER); my (@xs, @ys); # Pick some random points for (0..$POINTS-1) { push (@xs, rand()); push (@ys, rand()); } # Calculate screen for my $yi (0..$ROWS-1) { my $y = $yi * $yfact; for my $xi (0..$COLS-1) { my $x = $xi * $xfact; my ($best, $good) = closest($x, $y, \@xs, \@ys); $img->setPixel($xi, $yi, $colors->[$COLORS * ($best / $good)] +); } } binmode STDOUT; print $img->png(); #----------------------------------------------------------- sub closest { my ($x, $y, $xs, $ys) = @_; my ($dist, $best, $good); for (my $i = 0; $i < @$xs; $i++) { my $xdiff = abs($x - $xs->[$i]); my $ydiff = abs($y - $ys->[$i]); if ($xdiff > .5) { $xdiff = 1 - $xdiff; } if ($ydiff > .5) { $ydiff = 1 - $ydiff; } $dist = sqrt($xdiff * $xdiff + $ydiff * $ydiff); if ($i == 0 || $dist < $best) { ($good, $best) = ($best, $dis +t); } elsif ($i == 1 || $dist < $good) { $good = $dist; } } return ($best, $good); } #----------------------------------------------------------- sub makecolors { my ($img, $num, $beg, $end) = @_; my (@colors); my $red = ($end->[0] - $beg->[0]) / $num; my $green = ($end->[1] - $beg->[1]) / $num; my $blue = ($end->[2] - $beg->[2]) / $num; for (my $i = 0; $i < $num; $i++) { $beg->[0] += $red; $beg->[1] += $green; $beg->[2] += $blue; push (@colors, $img->colorAllocate(@$beg)); } return \@colors; }
        one other things you should change now that the size is a couple of orders of magnitude bigger...
        # Calculate screen for my $yi (0..$ROWS-1) { my $y = $yi * $yfact; for my $xi (0..$COLS-1) { ... } }

        Should be something like...

        # Calculate screen for (my $yi = 0; $yi < $ROWS; $yi++) { my $y = $yi * $yfact; for (my $xi = 0; $xi < $COLS; $xi++) { ... } }
      Sweet... I've never had a perl-generated background before... (Plus, it's nice example of how to use png... :-) )

      ----
      Zak
      "There is no room in this country for hyphenated Americanism" ~ Theodore Roosevelt (1915)
      Beautiful. Playing around with the color tables gives lots of pretty pictures. Now my destop image changes randomly thoughout the day. Oh what fun!
Re: Perl Spots
by YuckFoo (Abbot) on Aug 13, 2002 at 22:15 UTC
    Some explaining:

    A finite number of Voronoi points (v-points) are distributed on a plane. Each v-point has an associated neighborhood (v-hood). The v-hood is the set of points nearer to the v-point than any other v-point.

    To shade the v-hoods, I find the distances to the nearest two v-points and divide the smallest distance by the next smallest distance ($best / $good). This number will always be between 0 and 1. Points in the middle of a v-hood will be close to 0, points near the edge will be close to 1, being nearly the same distance from both points.

    Multiplying by 10 and using the integer result gives an index to the @CHARS array.

    Random v-points are added in the square with corners at (0,0) and (1,1). To achieve wrapping additional v-points are added in the eight surrounding squares.

    So for v-point (.2, .3), these points are added:
    (-.8, -.7) (-.8, .3) (-.8, 1.3)
    ( .2, -.7) ( .2, .3) ( .2, 1.3)
    (1.2, -.7) (1.2, .3) (1.2, 1.3)

    To see just the borders use:

    my @CHARS = split('', ' #');
    For stripes:
    my @CHARS = split('', ' # # # # #');
      Quite interesting. I've had a lot of fun playing with this (and not doing the work I'm supposed to be doing). It's fun watching what comes out when you used different values for rand() (:). Also changing @CHARS gives some interesting images. (Try '##########', for example). Coordinate geometry is PERLfectly FUNdamental!

      ------

      my {$two_cents = $_->food} for @thought; $will->code for @food or $$;
Re: Perl Spots
by BrowserUk (Patriarch) on Aug 14, 2002 at 01:29 UTC

    That's really neat!

    As for alternative charsets...these seem to work nicely on my NT box.

    my @CHARS=map{chr} qw(32 46 248 249 197 206 176 177 178 219); print "@CHARS\n";

    Not the most effective way of coding it, but convenient (for me).

    I doubt these values will work on a *nix system, unless there is a console font that emulates the old dos charset.

    Update: The effect is especially pleasing when I set the window to a 6-point TT-Luscida font, the window size to 201x120 (Wxh) and ($ROWS,$COLS) = (120,200);.

Re: Perl Spots (in ANSI color!)
by wedman (Sexton) on Aug 14, 2002 at 19:31 UTC

    You could use ANSI colors...

    my @CHARS = ( "\033[1;30;40m ", # dark grey on black "\033[1;30;40m@", # same thing, but prints '@' instead of ' ' "\033[1;30;47m@", # dark grey on light grey "\033[1;30;47m ", "\033[1;36;47m@", # light blue on light grey "\033[0;37;46m@", # light grey on light blue "\033[0;37;46m ", "\033[0;34;46m@", # dark blue on light blue "\033[0;36;44m@", # light blue on dark blue "\033[0;36;44m " );

    Now, these are strings as opposed to characters, but it still works.

Re: Perl Spots
by bilfurd (Hermit) on Aug 14, 2002 at 00:34 UTC
    Pretty cool, actually.

    I broke out the ASCII character table and tried using some chr() codes on my work (WinXP) box. My results were underwhelming, but you might have better luck.

Re: Perl Spots
by mattr (Curate) on Aug 20, 2002 at 12:17 UTC
    very cool! thanks for voronoi code.

    I found setting autoflush $|=1 to be very rewarding when used as a simple cgi (printed as text/html with PRE tag). Just feels good.

    Seems to be much the same speed even using CGI.pm to set the params x and y. I guess someone can now set up a voronoi desktop downloader service somewhere.. :0

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2024-03-28 21:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found