+--+--+--+--+--+--+--+--+--+--+
| 0| 0| 0| 0| 0| 0| 0| 0| 0| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 5| 5| 4| 3| 3| 2| 2| 1| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 5|10| 8| 6| 5| 4| 3| 1| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 3| 6| 5| 5| 5| 5| 4| 2| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 1| 2| 3| 4| 5| 6| 6| 3| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 0| 1| 2| 3| 5| 5| 4| 3| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 0| 0| 1| 2| 4| 3| 3| 2| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 0| 0| 0| 1| 2| 1| 2| 1| 0|
+--+--+--+--+--+--+--+--+--+--+
| 0| 0| 0| 0| 0| 0| 0| 0| 0| 0|
+--+--+--+--+--+--+--+--+--+--+
####
([0,0])x 0, ([0,1])x 0, ([0,2])x 0, ...
([0,1])x 0, ([1,1])x 5, ([2,1])x 5, ([3,1])x 4, ([4,1])x 3, ...
([0,2])x 0, ([1,2])x 5, ([2,2])x 10,([3,2])x 8, ...
...
####
#! perl -slw
use strict;
use Data::Dump qw[ pp ]; $Data::Dump::WIDTH = 1000;
use GD;
use constant { X => 0, Y=> 1, R => 2 };
sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }
my $RED = rgb2n( 255, 0, 0 );
my $GREEN = rgb2n( 0, 255, 0 );
my $BLUE = rgb2n( 0, 0, 255 );
my $YELLOW = rgb2n( 255, 255, 0 );
my $MAGENTA = rgb2n( 255, 0, 255 );
my $CYAN = rgb2n( 0, 255, 255 );
my $WHITE = rgb2n( 255,255,255 );
sub gen_rand {
my $rand_high = shift;
my $high_part = $rand_high;
my $rand_sum = 0;
while ($high_part) {
my $rand_arg = 1 + int rand $high_part;
$high_part -= $rand_arg;
$rand_sum += int rand $rand_arg;
}
return $rand_sum;
}
our $N //= 1000;
our $X //= our $Y //= 500;
our $W //= 10;
## Initialise the weight map to zeros.
my @map = map[ ( 0 ) x $X ], 1 .. $Y;
## Pick a random number of random 'peak' points.
my @peaks = map[ int rand $X, int rand $Y ], 1 .. ( 1 + rand( 8 ) );
for my $peak ( @peaks ) {
## pick a random value for this peak
my $val = 2 + int rand $W;
## and grade it out to the left edge (if the peak isn't at the left edge)
if( $peak->[X] > 0 ) {
my $delta = $val / ( $peak->[X] );
$map[ $peak->[Y] ][ $_ ] = $map[ $peak->[Y] ][ $_-1 ] + $delta for 1 .. $peak->[ X ];
}
## and grade it out to the right edge (if the peak isn't at the right edge)
if( $peak->[X] < $X ) {
my $delta = $val / ( $X - $peak->[X] );
$map[ $peak->[Y] ][ $_ ] = $map[ $peak->[Y] ][ $_-1 ] - $delta for $peak->[ X ]+1 .. $X;
}
}
## Now grade out between the x-lines and the top and bottom edges.
for my $x ( 0 .. $X-1 ) {
my $first = 0;
for my $second ( map( { $map[$_][$x] != 0 ? $_ : () } 0 .. $Y-1 ), $Y-1 ) {
my $delta = ( $map[ $second ][$x] - $map[ $first ][$x] ) / ( $second - $first );
$map[$_][$x] = $map[$_-1][$x] + $delta for $first+1 .. $second;
$first = $second;
}
}
## Draw and display the weight map as grey scale image for visualisation and checking
my $im = GD::Image->new( $X+2*100, $Y+2*100, 1 );
$im->fill( 0, 0, $WHITE );
$im->rectangle( 100, 100, $X+100, $Y+100, 0 );
for my $y ( 0 .. $#map ) {
for my $x ( 0 .. $#{ $map[0] } ) {
my $rgb = int( $map[$y][$x] ) * 255 / $W;
$im->setPixel( 100+$x, 100+$y, rgb2n( ( $rgb ) x 3 ) )
}
}
open PNG, '>:raw', "$0.png" or die $!;
print PNG $im->png;
close PNG;
system "$0.png";
## Vectorise the weight map to a weight stick
my $stick = '';
for my $y ( 0 .. $#map -1 ) {
for my $x ( 0 .. $#{ $map[ 0 ] } -1 ) {
## The -3 ensures isolated islands of points; but creates an edge case.
my $packed = pack( 'vv', $x, $y ) x ( $map[ $y ][ $x ] -3 );
$stick .= $packed;
}
}
## a sub that uses the weight stick to generate weighted random values.
sub rndPoint {
my $rnd = int rand( length( $stick ) / 4 );
my @point = unpack 'vv', substr( $stick, $rnd*4, 4 );
return \@point;
}
## generate some points
my @points = map rndPoint(), 1 ..$N;
## Draw the points over the weight map for checking
$im->filledArc( 100+$_->[X], 100+$_->[Y], 5, 5, 0, 360, $RED ) for @points;
## and display it.
open PNG, '>:raw', "$0.png" or die $!;
print PNG $im->png;
close PNG;
system "$0.png";