Portál AbcLinuxu, 19. prosince 2025 14:01
$a = [ [1, 3, 5, 7, 6],
[2, 5, 8, 2, 5],
[5, 7, 8, 1, 2],
[4, 2, 3, 5, 6],
[8, 6, 5, 4, 2] ];
while(@{$a}) {
push @list, @{shift $a};
push @list, pop($a->[$j++]) while @{$a->[$j]}; $j--;
push @list, reverse(@{pop $a});
push @list, shift($a->[$j]) while $j>0 && @{$a->[--$j]};
}
print "@list";
Řešení dotazu:
sub snake ($matrix is rw) {
my @snake;
while $matrix {
@snake.push: |.shift with $matrix; #left
@snake.push: |$_».pop with $matrix; #down
@snake.push: |.pop.reverse with $matrix; #right
@snake.push: |$_».shift.reverse with $matrix; #up
}
@snake
}
Trochu vylepšená verze
sub snake2 ($matrix is rw) {
my @snake;
my @take = |(
{ .shift }, #left
{ .map: *.pop }, #down
{ .pop.reverse }, #right
{ .map( *.shift ).reverse } #up
) xx *;
while $matrix {
my &action = @take.shift;
@snake.push: |$matrix.&action;
}
@snake
}
Verze s otočením:
sub snake3 (@matrix is copy) {
my @snake;
while @matrix {
@snake.push: |@matrix.shift;
@matrix = reverse [Z,] |@matrix;
}
@snake
}
while(@{$a}) {
push @list, @{shift $a};
push @list, map { pop $_ } @{$a};
push @list, reverse(@{pop $a});
push @list, reverse map { shift $_ } @{$a}
}
Vypadá to lépe, jen za cenu dalšího reverse().
@take jako nepovinný parametr
my @spiral = (
{ .shift }, #right
{ .map: *.pop }, #down
{ .pop.reverse }, #left
{ .map( *.shift ).reverse }, #up
);
sub snake2 ( @matrix, :@take is copy = |@spiral xx * ) {
my @snake;
while @matrix[0] {
my &action = @take.shift;
@snake.push: |@matrix.&action;
#say @matrix;
}
@snake;
}
Pak s tím lze dělat skopičiny jako opačná spirála začínající v pravém horním rohu:
my @reverse-spiral = |@spiral.rotate.map( { &reverse o $_ } ).reverse xx *;
say $matrix.&snake2(take => @reverse-spiral);
nebo třeba takovýto had:
my @right-left-down-up = |(
{ .shift }, #right
{ .shift.reverse }, #left
{ .map: *.shift }, #down
{ .map( *.shift ).reverse }, #up
) xx *; #repeat
say $matrix.&snake2(take => @right-left-down-up);
my @a = [ [ (0, 0), (100, 0), (100, 44), (62, 44), (0, 38), (1, 3) ],
[ (94, 100), (28, 50), (62, 44), (100, 44), (100, 100) ],
[ (0, 44), (28, 50), (94, 100), (0, 100), (3, 1) ],
[ (28, 50), (0, 44), (0, 38), (62, 44) ] ] ;
for 1..+@a -> $lineo {
my $b=@a.shift;
my $aflat=@a.List.flat.map({.Str});
my $bflat=$b.flat.map({.Str}).cache;
my $intersection = $aflat (&) $bflat;
say "$lineo: ", $intersection{$bflat.List}.pairs.Set.keys.sort;
@a.push: $b
}
Vůbec není nutné uvažovat o nějakém procházení pole a splněné podmínce, ale prostě se vytvoří vždy dvě množiny (jeden řádek a zbytek) na kterých se udělá průnik, a tím se zjistí, jaké dvojice se vyskytují na dalších řádcích. -- Možná by to šlo provést lépe, teprve začínám ;).
my @a = [
[(0, 0), (100, 0), (100, 44), (62, 44), (0, 38)],
[(94, 100), (28, 50), (62, 44), (100, 44), (100, 100)],
[(0, 44), (28, 50), (94, 100), (0, 100)],
[(28, 50), (0, 44), (0, 38), (62, 44)]
];
my @result;
for ^@a.elems .combinations(2) -> ($i, $j) {
next unless @a[$i].any eqv @a[$j].any;
@result[$i].push: $j;
@result[$j].push: $i;
}
@result.pairs».say;
Jestli si myslel, že by šlo použít např. X∩, tak jsem narazil na celkem dost problémů.
Nejvážnější je, že se to chová poněkud divně:
dd (set(1),set(2)) X∩ set(2),vypíše:
(set(set(1),set(2)), set(set(2))).SeqNamísto
@a[$i].any eqv @a[$j].any; bych mohl použít [or] @a[$i].list Xeqv @a[$j].list;, kdybych moc chtěl metaoperátory, ale takhle se mi to zdá přímější. Navíc ta část s Junction by se měla vyhodnocovat paralelně.
spiral =: 3 : 0
M =. y
r =. ''
while. #M > 0 do.
r =. r, {.M
M =. }.M
M =. |. |: M
end.
r
)
Určitě to není nejkratší zápis, zato je snadno pochopitelný :)
Tiskni
Sdílej:
ISSN 1214-1267, (c) 1999-2007 Stickfish s.r.o.