Генератор градиента на Perl шума


Я работаю на 2-Д графика с видом сверху двигателя, и нужен способ, чтобы имитировать облака. Моя идея заключалась в том, что я мог бы создать слой, состоящий из матрицы из прямоугольников, чьи Альфа-значение будет выбрать из соответствующей ячейки в отдельной матрице. Ниже-это Perl-код, который я написал для создания матрицы, состоящей из значений между 0 и 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;
}

Чтобы увидеть пример выходы, вот попробуйте его онлайн!

Мой Вопрос

Эта программа эффективна?
Без гольф кода, я могу что-то сделать, чтобы повысить эффективность?
Я упускаю что-то, что может быть проблемой при масштабировании по-другому? Скажем, матрицу размера 2000, или 1 000 000 проходов.

Что я не ищу

Я знаю, я должен использовать strict и warnings. В непосредственном смысле, я не забочусь об этом.

Поскольку я единственный человек, используя это, и это только прототип, чтобы быть переписана в другой язык позже, она преднамеренна, что у меня нет проверки типов ввода.



144
6
задан 7 февраля 2018 в 05:02 Источник Поделиться
Комментарии
1 ответ

Если вы хотите масштабировать для больших матриц не использовать массивы целых чисел. В то время как в 2000 х 2000 массив не вызовет проблем на современном оборудовании, понимаю, что хранить целое число в Perl занимает около 24 байт (это может немного отличаться от версии Perl и параметры компиляции). Это очень много памяти, чтобы хранить только один бит информации.

Вместо массивы, вы можете использовать строку, и использовать vec для переключения битов. Это позволит снизить потребление памяти на коэффициент 8 * 24 = 192.

3
ответ дан 10 февраля 2018 в 09:02 Источник Поделиться