10
\$\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\$
4
  • 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, 2018 at 20:35
  • 1
    \$\begingroup\$ Also, code golf is all about shortening the code and doesn't worry about efficiency. \$\endgroup\$
    – chicks
    Feb 12, 2018 at 20:35
  • 2
    \$\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, 2018 at 8:45
  • 1
    \$\begingroup\$ Note that to simulate clouds, one would typically use Perlin noise. At first I thought that that is what this code was about, that "Perl" was an attempt at writing "Perlin", but no, you're actually using the Perl programming language, which is an ... interesting choice for computer graphics. :) \$\endgroup\$ Mar 20 at 15:43

1 Answer 1

3
\$\begingroup\$

Overview

The code layout is good, and you used meaningful names for functions and variables. It's great that you added comments for each sub, along with the function's inputs.

CPAN

The code does not leverage anything from CPAN. For general matrix operations, there is likely some optimized code available on CPAN. Even if you do not install and use any module from there, you could still perform some research and get ideas from the source code there.

Strict and Warnings

I realize that you intentionally omit these from your code. However, since the goal of this site is to promote good coding practices, and all answers on the site are meant for everyone who reads this question, it is important to mention. This is for the benefit of readers who may be inexperienced with Perl.

The first item on every Perl code review is to make sure the code has:

use strict;
use warnings;

These pragmas help find bugs in your code.

Simpler

Here is a slightly simpler version of your printMatrix function. There is no reason to copy the @m array; you can just directly dereference $row:

sub printMatrix {
    for $row (@{ $_[0] }) {
        for $cell (@{ $row }) {
            $s .= sprintf '%.1f,', $cell;
        }
        $s =~ s/,$/\n/;
    }
    return $s;
}

Instead of copying the first element of @_ as an array, you can just dereference that as well (although, arguably at the expense of readability). Also, it is simpler to add the comma in the sprintf call.

Perlish

It is considered more "Perlish" to use map instead of the for/push combination for simple code:

sub makeMatrix {
    my $size = shift;
    $size--;
    my @m;
    for (0 .. $size) {
        my @arr = map { (rand() < .02) ? 1 : 0 } 0 .. $size;
        splice @m, 1, 0, \@arr;
    }
    return @m;
}

Linting

perlcritic identifies several style issues. Run it yourself to see the full report.

For example, don't call functions with a leading ampersand. Change:

@matrix = &makeMatrix(10);

to:

@matrix = makeMatrix(10);

Unused code

In the getAdjacent function, warnings correctly identified these lines as unused code:

$outX;
$outY;
$attempts;

They can be removed to simplify the code.

Naming

It is confusing to see $m twice in this expression:

$m[$m][$n]

Consider renaming the inner $m as something else, like $x:

$m[$x][$n]
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Thank you for this very thorough answer to my 6 year old post /genuine. A lot of the practices I used here (no strict or warnings, using ampersands on subroutine calls) were the result of my on-the-job training, and I did get better over the years. I actually didn't know about that usage of map, so thank you for pointing that out. \$\endgroup\$
    – Bee H.
    Mar 14 at 14:59

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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