Page 2 sur 512345

Codingame : Skynet Revolution : Solution PERL

Nouveau concours codingame auquel j’ai participé (d’ailleurs si vous avez d’autre lien de site réalisant des concours ça m’intéresse !)

Voici comment réaliser un 100% en Perl

Première question, assez simple :

#!/usr/bin/perl
select(STDOUT); $| = 1; # DO NOT REMOVE

# @author   : Scorfly
# @mail     : scorfly at gmail dot com

use Data::Dumper;

# My personal constant
use constant false => 0;
use constant true  => 1;

($r) = split(/ /, <STDIN>);
$r =~ s/\n//g;

($g) = split(/ /, <STDIN>);
$g =~ s/\n//g;

($l) = split(/ /, <STDIN>);
$l =~ s/\n//g;

$hasJumped = false;

while (1) {
    ($s) = split(/ /, <STDIN>);
    $s =~ s/\n//g;
    
    ($x) = split(/ /, <STDIN>);
    $x =~ s/\n//g;
    
    if ($hasJumped)
    {
        print "SLOW\n";
    }
    else
    {
        if ($s <= $g)
        {
            print "SPEED\n";
        }
        elsif ($s > $g+1 )
        {
            print "SLOW\n";
        }
        else
        {
            $tmp = $x+$s;
            if ($tmp > $r)
            {
                $hasJumped = true;
                print "JUMP\n";
            }
            else
            {
                print "WAIT\n";
            }
        }
    }
    
    # DEBUG
    print STDERR "$g - goufre \n";
    print STDERR "$r - size before goufre init \n";
    print STDERR "$l - size of plateform \n";
    print STDERR " \n";
    print STDERR "$s - speed \n";
    print STDERR "$x - pos \n";
    print STDERR "----------------";
    
}

Pour la seconde question j’ai du refaire le concours après car je n’ai pas réussi à obtenir le 100% lors de l’épreuve.

#!/usr/bin/perl
select(STDOUT); $| = 1; # DO NOT REMOVE

# @author   : Scorfly
# @mail     : scorfly at gmail dot com
# inspired by : http://www.codingame.com/cg/#!report:304298abe9483e149208d0eb19b780d62b7ae1
#   - Author : NewboO
#   - Infos : PHP 100%

use Data::Dumper;
use Switch 'Perl6';

my $m = <STDIN>; chomp $m;
my $v = <STDIN>; chomp $v;

my %roads;
for (my $i = 0 ; $i < 4; $i++)
{
    $roads->{$i} = <STDIN>; chomp $roads->{$i};
}

# Let's go to infinite
my @solution;

while(1)
{
    my $s = <STDIN>; chomp $s;
    my @motos;
    for(my $i=0; $i<$m; $i++)
    {
        my ($x, $y, $a) = split(/ /, <STDIN>); chomp $a;
        
        if($a)
        {
            push(@motos, [$x, $y]);
        }
    }
    
    @solution = getPath(\@motos, $s, $roads, $v);
    
    MyLogger(\@solution, "sol", 1);
    
    #$action = unshift(@solution);
    if (@solution)
    {
        print $solution[0];
    }
    else
    {
        print "SPEED";
    }
    print "\n";
}

##############
#   Sub part

# depending on speed, is there hole betweed our position and next round ?
#   - $s : speed
#   - $x : position on road
#   - $roads : road list
sub canDrive
{
    my ($s, $x, $roads) = @_;

    my @safe = qw(1 1 1 1);
    foreach $roadId (keys $roads)
    {
        my @cutedRoad = split("", $roads->{$roadId});
        for($i=$x; $i<=$x+$s; $i++)
        {
            if(defined($cutedRoad[$i]) && $cutedRoad[$i] eq "0")
            {
                $safe[$roadId] = 0;
                last;
            }
        }
    }
    return @safe;
}

# Check if we jump, who survive
#   - $s : speed
#   - $x : positon
#   - $roads : list of road
sub canJump
{
    my ($s, $x, $roads) = @_;

    my @safe;
    foreach my $roadId (keys $roads)
    {
        my @cutedRoad = split("", $roads->{$roadId});
        $safe[$roadId] = int (!defined($cutedRoad[$s+$x]) || $cutedRoad[$s+$x] eq '.');
    }
    return @safe;
}

#
# Check if some moto survive depending on the action
#
sub checkAction
{
    my ($motosH, $s, $action) = @_;
    my @motos = @$motosH;

    $x = $motos[0][0];
    if($action eq 'SPEED') { $s++; }
    elsif($action eq 'SLOW') { $s--; }
    
    if ($s == 0) { return (0, undef); }
    
    my @nMotos;
    given($action)
    {
        when (/(WAIT|SPEED|SLOW)/)
        {
            my @dSafe = canDrive($s, $x, $roads);
            foreach $moto (@motos)
            {
                if($dSafe[@$moto[1]])
                {
                    push(@nMotos, [@$moto[0]+$s, @$moto[1]]);
                }
            }
        }
        when ("DOWN")
        {
            my @dSafe = canDrive($s, $x, $roads);
            my @dOSafe = canDrive($s-1, $x, $roads);
            foreach my $moto (@motos)
            {
                if($dOSafe[@$moto[1]] && $dSafe[@$moto[1]+1] && @$moto[1]+1 < 4)
                {
                    push(@nMotos, [@$moto[0]+$s, @$moto[1]+1]);
                }
            }
        }
        when ("UP")
        {
            my @dSafe = canDrive($s, $x, $roads);
            my @dOSafe = canDrive($s-1, $x, $roads);

            foreach my $moto (@motos)
            {
                if($dOSafe[@$moto[1]] && $dSafe[@$moto[1]-1] && @$moto[1]-1 >= 0)
                {
                    push(@nMotos, [@$moto[0]+$s, @$moto[1]-1]);
                }
            }
        }
        when ("JUMP")
        {
            my @jSafe = canJump($s, $x, $roads);
            foreach my $moto (@motos)
            {
                if($jSafe[@$moto[1]])
                {
                    push(@nMotos, [@$moto[0]+$s, @$moto[1]]);
                }
            }
        }
    }
    
    if (@nMotos > 0)
    {
        return ($s, @nMotos);
    }
    else
    {
        return ($s, qw());
    }
}

#
# Check recursivly each action to finish the road
#
sub getPath
{
    my ($motosH, $s, $roads, $v, @current) = @_;
    my @motos = @$motosH;

    my @actionList = qw(SPEED UP DOWN WAIT JUMP SLOW);
    foreach my $action (@actionList)
    {
        my ($nS, @nMotos) = checkAction(\@motos, $s, $action);
        
        if(@nMotos >= $v)
        {
            push(@current, $action);
            my @cutedRoad = split("", $roads->{0});
            if($nMotos[0][0] >= @cutedRoad)
            {
                return @current;
            }
            else
            {
                @solution = getPath(\@nMotos, $nS, $roads, $v, @current);
                if (@solution)
                {
                    if ($solution[0] ne "")
                    {
                        return @solution;
                    }
                }
            }
            pop(@current);
        }
    }
}

# /**
#  * MyLogger  print data in STDERR to debug during developpement
#  *    - $value : value to print
#  *    - $comment : info about the value
#  *    - $debug (optionnal) : print $value in Data::Dumper
#  */
sub MyLogger {
    my ($value, $comment, $debug) = @_;
    
    if (!defined($debug)) {$debug = 0;}
    
    if($debug)
    {
        print STDERR "$comment : \n";
        print STDERR Dumper($value);
    }
    else
    {
        print STDERR "$comment : $value \n";
    }
}

Je me suis fait au passage une petite fonction pour le debug que je pense utiliser à chaque concours maintenant vu qu’il faut print les valeurs dans la STDERR pour débuguer son script.

Codingame : Tron Battle : C’est fini

La tron batte de codingame est fini, je vais enfin pouvoir re-profiter de mes soirées :p

L’aventure fut fort agréables. Au final 63ieme au classement, premier en Perl, devant Newrare et dans le top 10%, mes objectifs sont atteins.

La dernière soirée fut fort en émotion. J’étais 75ieme mais devant Newrare, donc je ne souhaitais pas envoyer la dernière version de mon code ayant des crainte de perdre des place dans le classement. Cependant celui-ci a envoyé une mise à jour qui l’a propulsé jusque la 50ieme place. Dans le stress et après un appel à 23h pour se « narguer », j’ai craqué et j’ai envoyé la dernière version de mon code. J’ai vu alors Newrare commencer à perdre beaucoup de place… L’envoie de mon dernier code dans l’arène était donc inutile pour passer devant lui, mais m’a donné pas mal de stress. Au final je le remercie car j’ai gagné des places précieuses aux classement, ce qui m’a permis d’atteindre le top 10%

Ce fut une bonne aventure que j’ai partagé IRL avec Newrare où nous avons pu débattre sur nos code et les mettre régulièrement en compétitions. Nous ne sommes pas des devs et nous utilisons le PERL uniquement sur codingame pour nous amuser.

J’ai parcouru les reviews de codes des autres joueurs et je remarque je fossé entre mon code et le leur … en même temps je n’aurais pas pu faire ce qu’ils ont fait en utilisant le Perl.

Le petit point un peut dommage est qu’il n’y pas de classement par langage. Il est quand même difficile de comparer du PHP / PERL au JAVA C++ pour ce qui sera des délais d’exécution. Tout langage devant répondre en moins de 100ms, le fait d’avoir choisir PERL m’a donc « défavoriser » (en même temps c’est mon choix, donc tampi pour moi).

Comment ça marche :

  • J’initialise les valeurs qui me sont donné et j’enregistre les prochains mouvement des mes adversaires.
  • Je regardes mes mouvements possibles et si je pourrais faire un second mouvement après le précédent (pour éviter les cul de sacs)
  • Si dans ma liste de prochain mouvement le mouvement d’après n’a qu’une possibilité et que celle-ci peut-être prise par un autre joueur -> trop risqué je supprime ce mouvement de la liste
  • Si dans les prochains mouvement je peux prendre le dernier mouvement possible d’un adversaire, je le tue.
  • Si j’ai plusieurs mouvement possible :
    • Si je rencontre un mur, je calcul la meilleure zone
    • Si J’ai un obstacle dans un angle, je calcul la meilleure zone
    • Sinon je regarde si je trouve un ennemie dans un cercle de neuf cases. Si j’en trouve un, j’attaque, sinon je choisi la plus grande direction.

Voila grosso modo comment fonctionne le script. Loin d’être bon pour le remplissage de zone, mais qui fonctionne « correctement »

Voici le script final que j’ai rendu.

#!/usr/bin/perl
select(STDOUT); $| = 1; # DO NOT REMOVE

# @author   : Scorfly
# @mail     : scorfly at gmail dot com

use Data::Dumper;
use List::Util 'shuffle';
use Switch;
use POSIX qw/floor/;

# My personal constant
use constant false => 0;
use constant true  => 1;

# The arena
use constant HEIGHT => 20;
use constant WIDTH  => 30;

# Some adjustment
use constant attack         => 9;
use constant attackMargin   => 0;
use constant zone           => 200;
use constant anticipation   => 1;

# list of vars
my ($nbPlayer, $position, $i, $n, $w, $x, $y, $z, $myY, $myZ, $move);
my %maps;
my @erased;
my @wall;
my $count = 0;

while (1) {
    my @target;
    $move = undef;
    $n = <STDIN>;
    ($nbPlayer, $position) = split(/ /, $n);
    $position =~ s/\n//g;
    
    my %listOfOtherNextMove;
    my %listOfOtherNextMoveQnt;
    
    for ($i = 0; $i < $nbPlayer; $i++)
    {
        $n = <STDIN>;
        ($w, $x, $y, $z) = split(/ /, $n);
        $z =~ s/\n//g;
        $maps->{$y}->{$z} = $i+1;
        push(@wall, ($z * WIDTH + $y));
        $maps->{$w}->{$x} = $i+1;
        push(@wall, ($x * WIDTH + $w));
        
        if ($x == -1)
        {
            if (!in_array(\@erased, ($i+1)))
            {
                push(@erased, ($i+1));
            }
        }
        else
        {
            if($position == $i)
            {
                $myY = $y;
                $myZ = $z;
            }
            else
            {
                # check direction of the ennemy and set the cell in front if him as a target
                if (anticipation)
                {
                    if ($w < $y && ($y+1) < WIDTH && !in_array(\@wall, (($z * WIDTH) + $y+1)))
                    {
                        push(@target, (($z * WIDTH) + $y+1));
                    }
                    elsif ($w > $y && $y > 0 && !in_array(\@wall, (($z * WIDTH) + $y-1)))
                    {
                        push(@target, (($z * WIDTH) + $y-1));
                    }
                    elsif ($x > $z && $z > 0 && !in_array(\@wall, ((($z-1) * WIDTH) + $y)))
                    {
                        push(@target, ((($z-1) * WIDTH) + $y));
                    }
                    elsif ($x < $z && ($z+1) < HEIGHT && !in_array(\@wall, ((($z+1) * WIDTH) + $y)))
                    {
                        push(@target, ((($z+1) * WIDTH) + $y));
                    }
                    else
                    {
                        push(@target, (($z * WIDTH) + $y));
                    }
                }
                else
                {
                    push(@target, (($z * WIDTH) + $y));
                }
                
                # register next move of the ennemy
                my @nextMove;
                if (canGoLeft($y, $z, \@erased, \%maps))
                {
                    push(@nextMove, ((($z) * WIDTH) + $y-1));
                }
                if (canGoRight($y, $z, \@erased, \%maps))
                {
                    push(@nextMove, ((($z) * WIDTH) + $y+1));
                }
                if (canGoUp($y, $z, \@erased, \%maps))
                {
                    push(@nextMove, ((($z-1) * WIDTH) + $y));
                }
                if (canGoDown($y, $z, \@erased, \%maps))
                {
                    push(@nextMove, ((($z+1) * WIDTH) + $y));
                }
                
                $listOfOtherNextMove->{$i} = \@nextMove;
                $listOfOtherNextMoveQnt->{$i} = @nextMove;
            }
        }
    }
    
    $z = $myZ;
    $y = $myY;
    
    my @move;
    my @nextMove;
    
    my @lastChance;
    my @listMoveRight;
    my @listMoveLeft;
    my @listMoveUp;
    my @listMoveDown;
    
    # check move you can do, and the move after.
    if (canGoLeft($y, $z, \@erased, \%maps))
    {
        push(@lastChance, "LEFT");
        push(@nextMove, (($z * WIDTH) + $y-1));
        if (canGoLeft($y-1, $z, \@erased, \%maps) || canGoUp($y-1, $z, \@erased, \%maps) || canGoDown($y-1, $z, \@erased, \%maps))
        {
            if (canGoLeft($y-1, $z, \@erased, \%maps))
            {
                push(@listMoveLeft, ((($z) * WIDTH) + $y-2));
            }
            if (canGoUp($y-1, $z, \@erased, \%maps))
            {
                push(@listMoveLeft, ((($z-1) * WIDTH) + $y-1));
            }
            if (canGoDown($y-1, $z, \@erased, \%maps))
            {
                push(@listMoveLeft, ((($z+1) * WIDTH) + $y-1));
            }
            
            push(@move, "LEFT");
        }
    }
    if (canGoRight($y, $z, \@erased, \%maps))
    {
        push(@nextMove, (($z * WIDTH) + $y+1));
        push(@lastChance, "RIGHT");
        if (canGoRight($y+1, $z, \@erased, \%maps) || canGoUp($y+1, $z, \@erased, \%maps) || canGoDown($y+1, $z, \@erased, \%maps))
        {
            if (canGoRight($y+1, $z, \@erased, \%maps))
            {
                push(@listMoveRight, ((($z) * WIDTH) + $y+2));
            }
            if (canGoUp($y+1, $z, \@erased, \%maps))
            {
                push(@listMoveRight, ((($z-1) * WIDTH) + $y+1));
            }
            if (canGoDown($y+1, $z, \@erased, \%maps))
            {
                push(@listMoveRight, ((($z+1) * WIDTH) + $y+1));
            }
            
            push(@move, "RIGHT");
        }
    }
    if (canGoUp($y, $z, \@erased, \%maps))
    {
        push(@lastChance, "UP");
        push(@nextMove, ((($z-1) * WIDTH) + $y));
        if (canGoRight($y, $z-1, \@erased, \%maps) || canGoLeft($y, $z-1, \@erased, \%maps) || canGoUp($y, $z-1, \@erased, \%maps))
        {
            if (canGoRight($y, $z-1, \@erased, \%maps))
            {
                push(@listMoveUp, ((($z-1) * WIDTH) + $y+1));
            }
            if (canGoUp($y, $z-1, \@erased, \%maps))
            {
                push(@listMoveUp, ((($z-2) * WIDTH) + $y));
            }
            if (canGoLeft($y, $z-1, \@erased, \%maps))
            {
                push(@listMoveUp, ((($z-1) * WIDTH) + $y-1));
            }
            
            push(@move, "UP");
        }
    }
    if (canGoDown($y, $z, \@erased, \%maps))
    {
        push(@lastChance, "DOWN");
        push(@nextMove, ((($z+1) * WIDTH) + $y));
        
        if (canGoRight($y, $z+1, \@erased, \%maps) || canGoLeft($y, $z+1, \@erased, \%maps) || canGoDown($y, $z+1, \@erased, \%maps))
        {
            if (canGoRight($y, $z+1, \@erased, \%maps))
            {
                push(@listMoveDown, ((($z+1) * WIDTH) + $y+1));
            }
            if (canGoDown($y, $z+1, \@erased, \%maps))
            {
                push(@listMoveDown, ((($z+2) * WIDTH) + $y));
            }
            if (canGoLeft($y, $z+1, \@erased, \%maps))
            {
                push(@listMoveDown, ((($z+1) * WIDTH) + $y-1));
            }
            
            push(@move, "DOWN");
        }
    }

    # if my next move is very ricky. I delete it
    if (in_array(\@move, "UP") && @listMoveUp == 1)
    {
        foreach my $key1 (keys $listOfOtherNextMove)
        {
            foreach (@listMoveUp)
            {
                if (in_array(@$listOfOtherNextMove{$key1}, $_))
                {
                    $value = "UP";
                    @move = grep {!/$value/} @move;
                }
            }
        }  
    }
    if (in_array(\@move, "DOWN") && @listMoveDown == 1)
    {
        foreach my $key1 (keys $listOfOtherNextMove)
        {
            foreach (@listMoveDown)
            {
                if (in_array(@$listOfOtherNextMove{$key1}, $_))
                {
                    $value = "DOWN";
                    @move = grep {!/$value/} @move;
                }
            }
        }  
    }
    if (in_array(\@move, "RIGHT") && @listMoveRight == 1)
    {
        foreach my $key1 (keys $listOfOtherNextMove)
        {
            foreach (@listMoveRight)
            {
                if (in_array(@$listOfOtherNextMove{$key1}, $_))
                {
                    $value = "RIGHT";
                    @move = grep {!/$value/} @move;
                }
            }
        }  
    }
    if (in_array(\@move, "LEFT") && @listMoveLeft == 1)
    {
        foreach my $key1 (keys $listOfOtherNextMove)
        {
            foreach (@listMoveLeft)
            {
                if (in_array(@$listOfOtherNextMove{$key1}, $_))
                {
                    $value = "LEFT";
                    @move = grep {!/$value/} @move;
                }
            }
        }  
    }
    
    # small aleatory part
    @move = shuffle(@move);

    # check if an ennemy has only one move. And check if i take it befor him
    $somebodyWillDieTonight = false;
    foreach my $key1 (keys $listOfOtherNextMove)
    {
        foreach (@nextMove)
        {
            if (in_array(@$listOfOtherNextMove{$key1}, $_))
            {
                if ($listOfOtherNextMoveQnt->{$key1} eq 1)
                {
                    $somebodyWillDieTonight = true;
                    $theVictimWillBe = $_;
                    last;
                }
            }
        }
        if ($somebodyWillDieTonight)
        {
            last;
        }
    }

    # if if can block an ennemy, i do
    if ($somebodyWillDieTonight)
    {
        print STDERR "Kill Him";
        
        $y_arr = $theVictimWillBe % WIDTH;
        $z_arr = floor( $theVictimWillBe / WIDTH);
        
        if ($y_arr < $y)
        {
            $move = "LEFT";
        }
        if($y_arr > $y)
        {
            $move = "RIGHT";
        }
        if($z_arr < $z)
        {
            $move = "UP";
        }
        if($z_arr > $z)
        {
            $move = "DOWN";
        }
        print $move . "\n";
    }
    # if there is only one move without rick, i take it
    elsif (@move eq 1)
    {
        print STDERR "Only One Move";
        $move = $move[0] ;
        print $move[0] . "\n";
    }
    # if there are many move, i check
    elsif (@move > 1)
    {
        # toucheWall
        if ($lastMove eq "LEFT" && !in_array(\@lastChance, "LEFT"))
        {
            $move = bestZone($y, $z, \@erased, \@move, \%maps);
        }
        elsif($lastMove eq "UP" && !in_array(\@lastChance, "UP"))
        {
            $move = bestZone($y, $z, \@erased, \@move, \%maps);
        }
        elsif($lastMove eq "DOWN" && !in_array(\@lastChance, "DOWN"))
        {
            $move = bestZone($y, $z, \@erased, \@move, \%maps);
        }
        elsif($lastMove eq "RIGHT" && !in_array(\@lastChance, "RIGHT"))
        {
            $move = bestZone($y, $z, \@erased, \@move, \%maps);
        }
        
        if (defined($move))
        {
            print STDERR "touchWall";
            print $move . "\n";
        }
        else
        {
            # checkCorner
            print STDERR "+--------+ \n";
            print STDERR Dumper(@move);
            print STDERR "+--------+ \n";
            
            if ($lastMove eq "LEFT"     && (in_array(\@move, "UP")      || in_array(\@move, "DOWN"))    && ( ( defined($maps->{$y-1}->{$z-1}) && !in_array(\@erased, $maps->{$y-1}->{$z-1}) && !defined($maps->{$y}->{$z-1}) )    || ( defined($maps->{$y-1}->{$z+1}) && !in_array(\@erased, $maps->{$y-1}->{$z+1}) && !defined($maps->{$y}->{$z+1})) ))
            {
                $move = bestZone($y, $z, \@erased, \@move, \%maps);
            }
            elsif($lastMove eq "UP"     && (in_array(\@move, "LEFT")    || in_array(\@move, "RIGHT"))   && ( ( defined($maps->{$y+1}->{$z-1}) && !in_array(\@erased, $maps->{$y+1}->{$z-1}) && !defined($maps->{$y+1}->{$z}) )    || ( defined($maps->{$y-1}->{$z-1}) && !in_array(\@erased, $maps->{$y-1}->{$z-1}) && !defined($maps->{$y-1}->{$z})) ))
            {
                $move = bestZone($y, $z, \@erased, \@move, \%maps);
            }
            elsif($lastMove eq "DOWN"   && (in_array(\@move, "LEFT")    || in_array(\@move, "RIGHT"))   && ( ( defined($maps->{$y+1}->{$z+1}) && !in_array(\@erased, $maps->{$y+1}->{$z+1}) && !defined($maps->{$y+1}->{$z}) )    || ( defined($maps->{$y-1}->{$z+1}) && !in_array(\@erased, $maps->{$y-1}->{$z+1}) && !defined($maps->{$y-1}->{$z})) ))
            {
                $move = bestZone($y, $z, \@erased, \@move, \%maps);
            }
            elsif($lastMove eq "RIGHT"  && (in_array(\@move, "UP")      || in_array(\@move, "DOWN"))    && ( ( defined($maps->{$y+1}->{$z-1}) && !in_array(\@erased, $maps->{$y+1}->{$z-1}) && !defined($maps->{$y}->{$z-1}) )    || ( defined($maps->{$y+1}->{$z+1}) && !in_array(\@erased, $maps->{$y+1}->{$z+1}) && !defined($maps->{$y}->{$z+1})) ))
            {
                $move = bestZone($y, $z, \@erased, \@move, \%maps);
            }
            
            if (defined($move))
            {
                print STDERR "checkCorner";
                print $move . "\n";
            }
            else
            {
            
                my @nodes, @testedNodes;
                push (@nodes, ($z * WIDTH + $y));
                my $turn = 0;
                my @targetMove;
                $path = pathToTarget(\@target, \%maps, \@nodes, \@testedNodes, $turn, \@erased);
                
                # target dount, i attack it
                if (defined($path))
                {
                    $y_arr = $path % WIDTH;
                    $z_arr = floor( $path / WIDTH);
                    
                    if ($y_arr < $y)
                    {
                        push(@targetMove, "LEFT");
                    }
                    if($y_arr > $y)
                    {
                        push(@targetMove, "RIGHT");
                    }
                    if($z_arr < $z)
                    {
                        push(@targetMove, "UP");
                    }
                    if($z_arr > $z)
                    {
                        push(@targetMove, "DOWN");
                    }
                }
        
                $alreadyPrint = 0;
                foreach $attack (@targetMove)
                {
                    if (in_array(\@move, $attack) && !$alreadyPrint)
                    {
                        print STDERR "attack";
                        $move = $attack;
                        print $move . "\n";
                        $alreadyPrint = 1;
                    }
                }
                
                # no target found, and no event "toucheWall" or "CheckCorner" juste get the best move
                if (!$alreadyPrint)
                {
                    print STDERR "Normal Way";
                    $move = getBestMove($y, $z, \@erased, \@move, \%maps);
                    print $move . "\n";
                }
            }
        }
    }
    elsif (@lastChance > 0)
    {
        # if nobody die, this is my last move :(
        print STDERR "lastChance \n";
        $move = $lastChance[0];
        print $move . "\n";
    }
    else
    {
        # i'm dead ... say chuck norris fact
        @fact = chuckNorrisFact();
        print $fact[0] . "\n";
    }
    
    $lastMove = $move;
}

########################
#
#   Function part
#
######

#
#
#
sub canGoLeft()
{
    my ($y, $z, $erasedHash, $mapsHash) = @_;
    my $result = false;
    my %maps = %$mapsHash;
    my @erased = @$erasedHash;
    
    if($y > 0 && ( (!defined($maps->{$y-1}->{$z})) || in_array(\@erased, $maps->{$y-1}->{$z}) ))
    {
        $result = true;
    }
    
    return $result;
}

#
#
#
sub canGoRight()
{
    my ($y, $z, $erasedHash, $mapsHash) = @_;
    my $result = false;
    my %maps = %$mapsHash;
    my @erased = @$erasedHash;
    
    if ($y+1 < WIDTH && ( (!defined($maps->{$y+1}->{$z})) || in_array(\@erased, $maps->{$y+1}->{$z}) ))
    {
        $result = true;
    }
    
    return $result;
}

#
#
#
sub canGoUp()
{
    my ($y, $z, $erasedHash, $mapsHash) = @_;
    my $result = false;
    my %maps = %$mapsHash;
    my @erased = @$erasedHash;
    
    if($z > 0 && ( (!defined($maps->{$y}->{$z-1})) || in_array(\@erased, $maps->{$y}->{$z-1}) ))
    {
        $result = true;
    }
    
    return $result;
}

#
#
#
sub canGoDown()
{
    my ($y, $z, $erasedHash, $mapsHash) = @_;
    my $result = false;
    my %maps = %$mapsHash;
    my @erased = @$erasedHash;
    
    if ($z+1 < HEIGHT && ( (!defined($maps->{$y}->{$z+1})) || in_array(\@erased, $maps->{$y}->{$z+1}) ))
    {
        $result = true;
    }
    
    return $result;
}

#
#
#
sub getBestMove()
{
    my ($y, $z, $erasedHash, $movesHash, $mapsHash) = @_;
    my $max = 0;
    my $bestMove = "UP";
    my %maps = %$mapsHash;
    my @moves = @$movesHash;
    my @erased = @$erasedHash;

    foreach my $dir (@moves)
    {
        my $count = 0;
        my $tmpy = $y;
        my $tmpz = $z;
        
        switch($dir)
        {
            case 'UP'
            {
                while ( &canGoUp($tmpy, $tmpz, $erasedHash, $mapsHash) )
                {
                    $count = $count + 1;
                    $tmpz = $tmpz - 1;
                }
            }
            case 'DOWN'
            {
                while ( &canGoDown($tmpy, $tmpz, $erasedHash, $mapsHash) )
                {
                    $count = $count + 1;
                    $tmpz = $tmpz + 1;
                }
            }
            case 'LEFT'
            {
                while ( &canGoLeft($tmpy, $tmpz, $erasedHash, $mapsHash) )
                {
                    $count = $count + 1;
                    $tmpy = $tmpy - 1;
                }
            }
            case 'RIGHT'
            {
                while ( &canGoRight($tmpy, $tmpz, $erasedHash, $mapsHash) )
                {
                    $count = $count + 1;
                    $tmpy = $tmpy + 1;
                }
            }
        }
        
        if ($count > $max)
        {
            $max = $count;
            $bestMove = $dir;
        }
    }
    
    return $bestMove;
}

#
#
#
sub calculateZoneUp
{
    my ($y, $z, $erasedHash, $movesHash, $mapsHash) = @_;
    
    my $count = 0;
    my $tmpy = $y;
    my $tmpz = $z+1;
        
    while ( &canGoUp($tmpy, $tmpz, $erasedHash, $mapsHash) )
    {
        $count++;
        $tmpz--;
        
        $tmp1y = $tmpy;
        $tmp1z = $tmpz;
        $tmp2y = $tmpy;
        $tmp2z = $tmpz;
        
        if ($count >= zone)
        {
            last;
        }
        
        while ( &canGoLeft($tmp1y, $tmp1z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp1y--;
            if ($count >= zone)
            {
                last;
            }
        }
        
        while ( &canGoRight($tmp2y, $tmp2z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp2y++;
            if ($count >= zone)
            {
                last;
            }
        }
    }
    
    return $count;
}

#
#
#
sub calculateZoneDown
{
    my ($y, $z, $erasedHash, $movesHash, $mapsHash) = @_;
    
    my $count = 0;
    my $tmpy = $y;
    my $tmpz = $z-1;
        
    while ( &canGoDown($tmpy, $tmpz, $erasedHash, $mapsHash) )
    {
        $count++;
        $tmpz++;
        
        $tmp1y = $tmpy;
        $tmp1z = $tmpz;
        $tmp2y = $tmpy;
        $tmp2z = $tmpz;
        
        if ($count >= zone)
        {
            last;
        }
        
        while ( &canGoLeft($tmp1y, $tmp1z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp1y--;
            if ($count >= zone)
            {
                last;
            }
        }
        
        while ( &canGoRight($tmp2y, $tmp2z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp2y++;
            if ($count >= zone)
            {
                last;
            }
        }
    }
    
    return $count;
}

#
#
#
sub calculateZoneLeft
{
    my ($y, $z, $erasedHash, $movesHash, $mapsHash) = @_;
    
    my $count = 0;
    my $tmpy = $y+1;
    my $tmpz = $z;
        
    while ( &canGoLeft($tmpy, $tmpz, $erasedHash, $mapsHash) )
    {
        $count = $count + 1;
        $tmpy--;
        
        $tmp1y = $tmpy;
        $tmp1z = $tmpz;
        $tmp2y = $tmpy;
        $tmp2z = $tmpz;
        
        if ($count >= zone)
        {
            last;
        }
        
        while ( &canGoDown($tmp1y, $tmp1z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp1z++;
            if ($count >= 50)
            {
                last;
            }
        }
        
        while ( &canGoUp($tmp2y, $tmp2z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp2z--;
            if ($count >= zone)
            {
                last;
            }
        }
    }
    
    return $count;
}

#
#
#
sub calculateZoneRight
{
    my ($y, $z, $erasedHash, $movesHash, $mapsHash) = @_;
    
    my $count = 0;
    my $tmpy = $y-1;
    my $tmpz = $z;
        
    while ( &canGoRight($tmpy, $tmpz, $erasedHash, $mapsHash) )
    {
        $count = $count + 1;
        $tmpy++;
        
        $tmp1y = $tmpy;
        $tmp1z = $tmpz;
        $tmp2y = $tmpy;
        $tmp2z = $tmpz;
        
        if ($count >= zone)
        {
            last;
        }
        
        while ( &canGoDown($tmp1y, $tmp1z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp1z++;
            if ($count >= 50)
            {
                last;
            }
        }
        
        while ( &canGoUp($tmp2y, $tmp2z, $erasedHash, $mapsHash) )
        {
            $count = $count + 1;
            $tmp2z--;
            if ($count >= zone)
            {
                last;
            }
        }
    }
    
    return $count;
}

#
#
#
sub bestZone
{
    my ($y, $z, $erasedHash, $movesHash, $mapsHash) = @_;
    my $max = 0;
    my $bestMove = "UP";
    my @moves = @$movesHash;
    my $bestTmpMove;
    my @listMove = shuffle('UP', 'DOWN', 'LEFT', 'RIGHT');

    foreach my $dir (@moves)
    {
        my $count = 0;
        
        switch($dir)
        {
            case 'UP'
            {
                $tmpCount = &calculateZoneUp($y, $z-1, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "UP";}
                
                $tmpCount = &calculateZoneLeft($y, $z-1, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "UP";}
                
                $tmpCount = &calculateZoneRight($y, $z-1, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "UP";}
            }
            case 'DOWN'
            {
                $tmpCount = &calculateZoneDown($y, $z+1, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "DOWN";}
                
                $tmpCount = &calculateZoneLeft($y, $z+1, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "DOWN";}
                
                $tmpCount = &calculateZoneRight($y, $z+1, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "DOWN";}
            }
            case 'LEFT'
            {
                $tmpCount = &calculateZoneDown($y-1, $z, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "LEFT";}
                
                $tmpCount = &calculateZoneLeft($y-1, $z, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "LEFT";}
                
                $tmpCount = &calculateZoneUp($y-1, $z, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "LEFT";}
            }
            case 'RIGHT'
            {
                $tmpCount = &calculateZoneDown($y+1, $z, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "RIGHT";}
                
                $tmpCount = &calculateZoneRight($y+1, $z, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "RIGHT";}
                
                $tmpCount = &calculateZoneUp($y+1, $z, $erasedHash, $mapsHash);
                if($tmpCount > $count){($count = $tmpCount);$tmpMove = "RIGHT";}
            }
        }
        
        if ($count > $max)
        {
            $max = $count;
            $bestMove = $dir;
        }
        if ($count >= zone)
        {
            last;
        }
    }
    
    return $bestMove;
}

#
#
#
sub in_array
{
     my ($arr,$search_for) = @_;
     my %items = map {$_ => 1} @$arr;
     return (exists($items{$search_for}))?1:0;
}

#
#
#
sub in_hash {
     my ($hash,$search_for) = @_;
     return grep {$search_for eq $_} %$hash;
}

#
#
#
sub neighbours
{
    my ($cell) = @_;
    my %neighbours;

    if($cell == 0){
        $neighbours = { $cell+1 => 1, ($cell + WIDTH) => 1 };
    }
    elsif($cell == WIDTH - 1){
        # up/right
        $neighbours = { ($cell + WIDTH) => 1, $cell-1 => 1 };
    }
    elsif($cell == (HEIGHT - 1)* WIDTH){
        # down/left
        $neighbours = { $cell+1 => 1, ($cell - WIDTH) => 1 };
    }
    elsif($cell == HEIGHT * WIDTH - 1){
        # down/right
        $neighbours = { $cell-1 =>  1, ($cell - WIDTH) => 1 };
    }
    elsif($cell < WIDTH){
        # top
        $neighbours = { $cell+1 => 1, ($cell + WIDTH) => 1, $cell-1 =>  1 };
    }
    elsif($cell % WIDTH == 0){
        # left
        $neighbours = { $cell+1 => 1, ($cell + WIDTH) => 1, ($cell - WIDTH) => 1 };
    }
    elsif($cell % WIDTH == WIDTH-1){
        # right
        $neighbours = { ($cell + WIDTH) => 1, $cell-1 =>  1, ($cell - WIDTH) => 1 };
    }
    elsif($cell > (HEIGHT-1) * WIDTH){
        # down
        $neighbours = { $cell+1 => 1, $cell-1 =>  1, ($cell - WIDTH) => 1 };
    }
    else{
        $neighbours = { $cell+1 => 1, ($cell + WIDTH) => 1, $cell-1 => 1, ($cell - WIDTH) => 1 };
    }
    
    return $neighbours;
}

#
#
#
sub pathToTarget
{
    my ($targetRef, $mapsRef, $nodesRef, $testedRef, $turn, $erasedHash) = @_;
    my %maps        = %$mapsRef;
    my @target      = @$targetRef;
    my @nodeList    = @$nodesRef;
    my @testedNodes = @$testedRef;
    my @erased      = @$erasedHash;
    my @nodeToTest;
    my %eltern;
    $turn++;

    if ($turn > attack)
    {
        return undef;
    }
    
    foreach $node (@$nodesRef)
    {
        if (!in_array(\@testedNodes, $node))
        {
            push(@testedNodes, $node);
            $neighbours = undef;
            $neighbours = neighbours($node);
            
            foreach $neighbour (keys $neighbours)
            {
                $tmpx = $neighbour % WIDTH;
                $tmpy = floor( $neighbour / WIDTH);
                
                if (in_array($targetRef, $neighbour))
                {
                    if ($turn <= attackMargin)
                    {
                        return undef;
                    }
                    else
                    {
                        return $node;
                    }
                }
                elsif ((!defined($maps->{$tmpx}->{$tmpy}) || ( defined($maps->{$tmpx}->{$tmpy}) && in_array($erasedHash, $maps->{$tmpx}->{$tmpy}))) && !in_array(\@testedNodes, $neighbour) && !in_array(\@nodeToTest, $neighbour) )
                {
                    $eltern{$neighbour} = $node;
                    push(@nodeToTest, $neighbour);
                }
            }
        }
    }
    
    if (@nodeToTest > 0)
    {
        $node = pathToTarget($targetRef, $mapsRef, \@nodeToTest, \@testedNodes, $turn, $erasedHash);
        
        if (defined($node))
        {
            if ($turn eq 1)
            {
                return $node;
            }
            else
            {
                return $eltern{$node};
            }
        }
        else
        {
            return undef;
        }
    }
    else
    {
        return undef;
    }
}

#
#
#
sub chuckNorrisFact
{
    my @fact =
    (
        'Life only exists because Chuck Norris needs something to look at',
        'When Alexander Bell invented the telephone he had 3 missed calls from Chuck Norris',
        'Fear of spiders is aracnaphobia, fear of tight spaces is chlaustraphobia, fear of Chuck Norris is called Logic ',
        'Chuck Norris doesn\'t call the wrong number. You answer the wrong phone.',
        'Chuck Norris has a grizzly bear carpet in his room. The bear isn\'t dead it is just afriad to move.',
        'There used to be a street named after Chuck Norris, but it was changed because nobody crosses Chuck Norris and lives',
        'Chuck Norris died 20 years ago, Death just hasn\'t built up the courage to tell him yet.',
        'If you rate this 5 roundhouse kicks, then Chuck Norris WILL roundhouse kick Justin Bieber\'s ass.',
        'Chuck Norris has already been to Mars; that\'s why there are no signs of life.',
        'Some magicans can walk on water, Chuck Norris can swim through land.',
        'Chuck Norris and Superman once fought each other on a bet. The loser had to start wearing his underwear on the outside of his pants.',
        'Chuck Norris once urinated in a semi truck\'s gas tank as a joke....that truck is now known as Optimus Prime.',
        'Chuck Norris can cut through a hot knife with butter',
        'Chuck Norris counted to infinity - twice.',
        'Chuck Norris is the reason why Waldo is hiding',
        'Death once had a near-Chuck Norris experience',
        'Chuck Norris can slam a revolving door.',
        'When the Boogeyman goes to sleep every night, he checks his closet for Chuck Norris',
        'Chuck Norris will never have a heart attack. His heart isn\'t nearly foolish enough to attack him',
        'Chuck Norris once kicked a horse in the chin. Its decendants are known today as Giraffes',
        'Chuck Norris can win a game of Connect Four in only three moves',
        'Chuck Norris once got bit by a rattle snake........ After three days of pain and agony ..................the rattle snake died',
        'There is no theory of evolution. Just a list of animals Chuck Norris allows to live'
    );
    
    return shuffle(@fact);
}

Implementation de Dijkstra en PERL

Pour les besoin du concours de CodinGame, la Tron Battle j’ai implémenté l’algorithme de Dijkstra en PERL.

Pourquoi c’est algorithme ? Celui-ci permet de calculé le plus court chemin entre deux noeud. Mon but étant de me rapprocher le plus rapidement de mon adversaire pour le limiter dans ses mouvement. Comme on le dit souvent, la meilleurs défense c’est l’attaque !

#!/usr/bin/perl

sub array_diff(\@\@) {
    my %e = map { $_ => undef } @{$_[1]};
    return @{[ ( grep { (exists $e{$_}) ? ( delete $e{$_} ) : ( 1 ) } @{ $_[0] } ), keys %e ] };
}

sub in_array
{
     my ($arr,$search_for) = @_;
     my %items = map {$_ => 1} @$arr; 
     return (exists($items{$search_for}))?1:0;
}

sub array_unique
{
    my %seen = ();
    @_ = grep { ! $seen{ $_ }++ } @_;
}

sub dijkstra {
    my ($graph_arrayHash, $source, $target) = @_;
    my @graph_array = @$graph_arrayHash;
    my @vertices;
    my %neighbours;
    my %previous;

    foreach  $edge (@graph_array) {
        push(@vertices, @$edge[0]);
        push(@vertices, @$edge[1]);
        $neighbours{@$edge[0]}->{@$edge[1]} = @$edge[2];
    }

    @vertices = array_unique(@vertices);

    foreach $vertex (@vertices) {
        $dist{$vertex} = inf;
        $previous{$vertex} = undef;
    }

    $dist{$source} = 0;

    while (@vertices > 0) 
    {
        $min = inf;
        foreach $vertex (@vertices){
            if ($dist{$vertex} < $min) {
                $min = $dist{$vertex};
                $u = $vertex;
            }
        }

        $diff = [ $u ];
        if (in_array(\@vertices, $u))
        {
            @vertices = array_diff(@vertices, @$diff);    
        }

        if ($dist{$u} == inf or $u == $target) {
            last;
        }

        if (defined($neighbours{$u})) {
            foreach $next (keys %{$neighbours{$u}}) {
                $alt = $dist{$u} + $neighbours{$u}->{$next};
                if ($alt < $dist{$next}) {
                    $dist{$next} = $alt;
                    $previous{$next} = $u;
                }
                delete $neighbours{$next}->{$u};
            }
        }
    }

    @path;
    $u = $target;

    while (defined($previous{$u})) {
        unshift(@path, $u);
        $u = $previous{$u};
    }
    unshift(@path, $u);
    return \@path;
}

Voici un exemple d’utilisation :

$nodeList = [
    ["node_1", "node_2", 7],
    ["node_1", "node_3", 9],
    ["node_2", "node_4", 10],
    ["node_2", "node_1", 15],
    ["node_3", "node_1", 14],
    ["node_3", "node_5", 13],
    ["node_4", "node_2", 9],
    ["node_5", "node_6", 2]

];

$path = dijkstra($nodeList, "node_1", "node_6");

print Dumper($path);

Voici le résultat fournis :

$ perl dijkstra.pl
$VAR1 = [
          'node_1',
          'node_3',
          'node_5',
          'node_6'
        ];

Malheureusement pour moi ce script ne répond pas dans les délais impartie ^^ J’ai plus qu’à passer sur un autre algo tel que A*

Page 2 sur 512345