No such thing as a small change PerlMonks

### comment on

 Need Help??
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;
}

In reply to Re: Re: Perl Spots by YuckFoo
in thread Perl Spots by YuckFoo

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or or How to display code and escape characters are good places to start.

Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2022-05-28 21:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Do you prefer to work remotely?

Results (101 votes). Check out past polls.

Notices?