6
\$\begingroup\$

I'm working on 2-D top-down graphics engine, and need a way to simulate clouds. My idea was that I could create a layer comprised of a matrix of rectangles whose alpha value would be picked from a corresponding cell in a separate matrix. Below is the Perl code I've written to generate a matrix comprised of values between 0 and 1.

###########################
# Author: Geoffrey Hudson
# Date: 2/6/2018
# Purpose: Generate a matrix of values between 0 and 1 inclusive that can be used as alpha values for cloud like patterns


# Generate a 10x10 matrix until I get one that isn't empty
do{
    @matrix = &makeMatrix(10);
}while(!&sumMatrix(\@matrix));

# "Cloud-ify" my matrix with 5 passes
&cloudMatrix(\@matrix, 5);

# Print my matrix to STDOUT
print &printMatrix(\@matrix);

###########################
# Generates a matrix with the dimensions size X size.
# Each cell has an 2% chance of being 1, which are used as the seed values for future growth.
sub makeMatrix{
    @m = ();
    $size = shift;
    $size--;
    for(0..$size){
        my @arr = ();
        for(0..$size){
            $n = rand() < .02 ? 1 : 0;
            push(@arr, $n);
        }
        splice @m, 1, 0, \@arr;
    }
    return @m;
}

###########################
# Returns the X and Y values of a cell adjacent to the input.
# $notX and $notY are given when finding a cell adjacent to the previously adjacent cell, and we do not want the starting point.
# E.G.
#   start = [0][4]
#   adjacent = [1][4]
#   adjacent2 = getadjacent(@m, 1,4,0,4) = [1][3]
# Params:
#       @m: the matrix
#       $x: the X coord to start with
#       $y: the Y coord to start with
#       $notX: if given, an X value that cannot be used, elsewise set to -1
#       $notY: if given, an Y value that cannot be used, elsewise set to -1
sub getAdjacent{
    @m = @{ $_[0] };
    $x = $_[1];
    $y = $_[2];
    $notX = $_[3] ? $_[3] : -1;
    $notY = $_[4] ? $_[4] : -1;

    $outX;
    $outY;

    $attempts;
    do{
        # A catch to prevent endless looping. Left over from testing various while conditions. Left in just in case.
        $attempts++;
        if($attempts > 1000){
            die "$outX: $x | $notX\n$outY: $y | $notY";
        }

        do{
            $outX = (int(rand(3))-1) + $x;
        }while($outX < 0 || $outX >= scalar @m);
        do{
            $outY = (int(rand(3))-1) + $y;
        }while($outY < 0 || $outY >= scalar @{ $m[$x] });
    }while(($outX == $x && $outX == $notX) && ($outY == $y && $outY == $notY));

    return ($outX, $outY);
}

###########################
# Finds the higher of two numbers.
# Params:
#       $n1: any given number
#       $n2: any other given number
sub getMinMax{
    $n1 = shift;
    $n2 = shift;

    if($n1 <= $n2){
        return ($n1, $n2);
    }
    else{
        return($n2, $n1);
    }
}

###########################
# Given a matrix, iterate over it $rounds times.
# Simple Steps:
#   1. Iterate through the rows
#   2. In each row, check each cell
#   3. If a cell != 0, find an adjacent cell
#   4. Find a cell that is adjacent to the previously found adjacent cell, that is not the parent cell
#   5. Set the value of the first adjacent cell to a value between the parent cell, and the second adjacent cell
#       such that the value is greater than 0, and less than 1
# Params:
#       @m: a matrix
#       $rounds: the number of times to go over the matrix
sub cloudMatrix{
    @m = @{ $_[0] };
    $rounds = $_[1]-1;

    for(0..$rounds){
        for($i=0;$i<scalar @m;$i++){
            for($j=0;$j<scalar @{ $m[$i] }; $j++){
                if($m[$i][$j] != 0){
                    ($k, $l) = &getAdjacent(\@m, $i, $j);
                    if($m[$k][$l] != 0) { next; }
                    ($m, $n) = &getAdjacent(\@m, $k, $l, $i, $j);
                    ($min, $max) = &getMinMax($m[$m][$n], $m[$i][$j]);
                    if($min == $max){
                        $newVal = $min;
                    }else{
                        $attempts = 0;
                        do{
                            $newVal = sprintf('%.1f', rand($max)+($min+.004));
                            $attempts++;
                        }while($newVal > 1);
                    }
                    $m[$k][$l] = $newVal;
                }
            }
        }
    }
}

###########################
# Returns the sum of the matrix.
# Used to ensure I'm not getting empty arrays.
sub sumMatrix{
    return eval join "+", map { join "+", @{ $_ }} @{ $_[0] };
}

###########################
# prints the array in such a way that I can easily split it for javascript array later.
# Params:
#       @m: the matrix to print
sub printMatrix{
    @m = @{ $_[0] };
    foreach $row (@m){
        @r = @{ $row };
        foreach $cell (@r){
            $cell = sprintf('%.1f', $cell);
            $s .= "$cell,";
        }
        $s =~ s/,$/\n/;
    }
    return $s;
}

To see example outputs, here is a Try it online!

My Question

Is this program efficient?
Without code golfing it, is there anything I could do to increase efficiency?
Am I missing something that could be a problem when scaled differently? Say, a matrix sized 2000, or 1,000,000 passes.

What I'm Not Looking For

I know, I should use strict and warnings. In the immediate sense, I don't care about that.

As I'm the only person using this, and this is only a prototype to be rewritten in a different language later on, it is intentional that I have no checks on input types.

\$\endgroup\$
  • 1
    \$\begingroup\$ Prototypes can live forever. If the prototype works it may be good enough that it is never rewritten. Programming defensively (like use strtict;) is a good habit to stick with. \$\endgroup\$ – chicks Feb 12 '18 at 20:35
  • 1
    \$\begingroup\$ Also, code golf is all about shortening the code and doesn't worry about efficiency. \$\endgroup\$ – chicks Feb 12 '18 at 20:35
  • 1
    \$\begingroup\$ I agree with @chicks here. It's not only the strict and warnings pragmata, but the overall readability of your code. If you want to rewrite this in another language later, it's even more important that you can later still read it. Longer variable names don't cost you extra. You spent a lot of time on very clear comments, but your code does not really match. \$\endgroup\$ – simbabque Mar 27 '18 at 8:45
3
\$\begingroup\$

If you want to scale to large matrices I wouldn't use arrays of integers. While a 2000 x 2000 array will not cause a problem on modern hardware, do realize that storing an integer in Perl takes about 24 bytes (this may vary a bit on Perl version and compilations parameters). That's a lot of memory to store just one bit of information.

Instead of arrays, you can use a string, and use vec to toggle bits. This will reduce your memory consumption by a factor of 8 * 24 = 192.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.