1. Друзья, в это тяжёлое и непонятное для всех нас время мы просим вас воздержаться от любых упоминаний политики на форуме, - этим ситуации не поможешь, а только возникнут ненужные ссоры и обиды. Это касается также шуток и юмора на тему конфликта. Пусть войны будут только виртуальными, а политики решают разногласия дипломатическим путём. С уважением, администрация Old-Games.RU.

    Скрыть объявление
  2. Если Вы видите это сообщение, значит, вы ещё не зарегистрировались на нашем форуме.

    Зарегистрируйтесь, если вы хотите принять участие в обсуждениях. Перед регистрацией примите к сведению:
    1. Не регистрируйтесь с никами типа asdfdadhgd, 354621 и тому подобными, не несущими смысловой нагрузки (ник должен быть читаемым!): такие пользователи будут сразу заблокированы!
    2. Не регистрируйте больше одной учётной записи. Если у вас возникли проблемы при регистрации, то вы можете воспользоваться формой обратной связи внизу страницы.
    3. Регистрируйтесь с реально существующими E-mail адресами, иначе вы не сможете завершить регистрацию.
    4. Обязательно ознакомьтесь с правилами поведения на нашем форуме, чтобы избежать дальнейших конфликтов и непонимания.
    С уважением, администрация форума Old-Games.RU
    Скрыть объявление

Алгоритм поиска пути

Автор: Helmut · 24 апр 2023 ·
  1. Вряд ли я когда-нибудь сяду писать собственную игру (с блэкджеком), но все равно, сохраню, пожалуй. Получилось не так уж плохо. Алгоритм поиска пути по карте из точки A в точку B через препятствия сложной формы. Сделан под прямоугольную сетку координат, но легко адаптируется под гексагональную.

    Код:
    #!/usr/bin/perl
    print "Content-Type: text/html\n\n";
    
    my @map_raw = qw /
        111111111111111111111111111111111111111111111111111111111111111111111111111
        111111111111111111111111111111111111111111111111111111111111111111111111111
        111111111111111111111111111111111111111111111111111111111111111111111111111
        111111111111111111111111111111111111111111111111111111111111111111111111111
        111111111111111111111111111111111111111111111111111111111111111111111111111
        111111110000000000000000000000100000000000000000000000010000000000000011111
        111110000000000000000000000111100000000000000000000000010000000000000001111
        111111000000000000000000000010000000000000000000000000010000000000001111111
        111000000000000001000000000010000000000000000000000000010000000000011111111
        110000000000000001000000000010000000000000000000000000010000000000001111111
        100000000000000001100000000001000000000000111111111111110000000000001111111
        000000000000000000111111111111000000000000100000000000000000000000111111111
        110000000000000000000000000001000000000000100000000000000000000001111111111
        111000000000011111111111111111111111111111100000000000000001111111111111111
        111000000000010000000000000001000000000000000111100000000000011111111111111
        111100000000010000000000000001000000000000000111110000000000001111111111111
        111110000000011111000000000001000000000000000011100000000000000111111111111
        111000000000000000000000001111111100000000000001000000000000111111111111111
        111111111111111111111111111111111111111111111111110000011111111111111111111
        111111111111111111111111111111111111111111111111111110000111111111111111111
        111111111111111111111111111111111111111111111111111111100111111111111111111
    /;
    
    my $start_path = {x => 47, y => 5};
    my $end_path = {x => 10, y => 20};
    
    use Storable qw/dclone/;
    my ($map, $matrix) = ({}, []);
    @{$matrix} = map {[map {{pass => $_}} split(//, $_)]} reverse @map_raw;
    for (my $i = 0; $i <= $#{$matrix}; $i++) {
        for (my $j = 0; $j <= $#{$matrix->[$i]}; $j++) {
            $map->{$j}->{$i} = $matrix->[$i]->[$j];
        }
    }
    
    my $path = find_path($map, $start_path, $end_path);
    
    foreach my $item (@{$path}) {
       $map->{$item->{x}}->{$item->{y}}->{red} = 1;
    }
    
    print '<TT>';
    for (my $i = 0; $i <= 21; $i++) {
       for (my $j = 0; $j <= 74; $j++) {
           if ($map->{$j}->{$i}->{red}) {
               print '<font color="red">';
               print $map->{$j}->{$i}->{pass};
               print '</font>';
           } else {
               print $map->{$j}->{$i}->{pass};
           }
       }
       print '<br>';
    }
    print '</TT>';
    
    sub find_path {
        my ($map, $start_path, $end_path) = @_;
        my ($pathes, $index) = ({}, 1);
    
        my ($x, $y) = ($start_path->{x}, $start_path->{y});
        $map->{$x}->{$y}->{path} = 1;
        $pathes->{$index} = [{x => $x, y => $y}];
    
        while (scalar keys %{$pathes}) {
            foreach my $cur (keys %{$pathes}) {
                my $old = dclone($pathes->{$cur});
                my $steps = find_steps($map, $pathes->{$cur}->[-1]);
                for (my $i = 0; $i <= $#{$steps}; $i++) {
                    my $new = $cur;
                    my ($sx, $sy) = ($steps->[$i]->{x}, $steps->[$i]->{y});
                    if ($i > 0) {
                        $index++;
                        $new = $index;
                        $pathes->{$new} = dclone($old);
                    }
                    push @{$pathes->{$new}}, $steps->[$i];
                    $map->{$sx}->{$sy}->{path} = 1;
                    if ($sx == $end_path->{x} && $sy == $end_path->{y}) {
                        return $pathes->{$new};
                    }
                }
                delete $pathes->{$cur} unless (scalar @{$steps});
            }
        }
        return;
    }
    
    sub find_steps {
        my ($map, $path) = @_;
        my ($x, $y) = ($path->{x}, $path->{y});
    
        my $steps = [];
        my @pass = (
            {x => $x, y => $y+1},
            {x => $x-1, y => $y},
            {x => $x+1, y => $y},
            {x => $x, y => $y-1},
        );
        foreach my $i (@pass) {
            my $cell //= $map->{$i->{x}}->{$i->{y}};
            if ($cell && !$cell->{path} && $cell->{pass}) {
                push @{$steps}, $i;
            }
        }
        return $steps;
    }
    
    nilegio, Eraser и Skud нравится это.

Комментарии

Чтобы оставить комментарий просто зарегистрируйтесь и станьте участником!
  1. На этом сайте используются файлы cookie, чтобы персонализировать содержимое, хранить Ваши предпочтения и держать Вас авторизованным в системе, если Вы зарегистрировались.
    Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie.
    Скрыть объявление