LINUX.ORG.RU

Perl. Некорректная работа скрипта.

 , ,


0

1

Доброго времени суток!

Задача: Есть функция anagram, которой на вход подается ссылка на массив из слов. Функция должна возвратить хэш, ключами которого являются первые встретившиеся слова из множества анаграмм, значениями должны являться ссылки на массив, каждый элемент которого слово из множества, в том порядке в котором оно встретилось в словаре в первый раз. Одинаковые слова из множества должны быть удалены, все слова должны быть приведены к одному регистру.

Пример входных данных:

Торс
Стоп
кукла
рост
КуЛак
кулак
ПОст
сорт

Пример выходных данных:

торс,стоп,кукла,рост,кулак,кулак,пост,сорт
торс,стоп,кукла,рост,кулак,пост,сорт
кукла: кукла кулак
стоп: стоп пост
торс: торс рост сорт

Сам скрипт:

#!/usr/bin/perl

use strict;
use utf8;
use locale;
no warnings;
use 5.10.0;

my @list = qw(Торс Стоп кукла рост КуЛак кулак ПОст сорт);

sub anagram {
    my $arrayref = shift;
    my $index = 0;
    my @array;
    my @uniq;
    my @match;
    my %hash;
    my %uniq = ();
    for (my $i = 0; $i < $#$arrayref; $i++ ) {
	    push @array, lc(@$arrayref[$i]);
    }
    say join ",", @array;
    @uniq = grep { !$uniq{$_}++ } @array;
    say join ",", @uniq;
    while (@uniq) {
	    my @chars = split(//, @uniq[0]);
        my @indexes;
	    my $regex = "[";
	    for (my $i = 0; $i < scalar @chars; $i++) {
	        $regex = $regex . $chars[$i];
	    }
	    $regex = $regex . "]{" . scalar @chars . "}";
        for (my $i = 0; $i < scalar @uniq; $i++) {
            if ($uniq[$i] =~ m/$regex/) {
               push @indexes, $i;
               $match[$index][$i] = $uniq[$i];
            }
        }
        $hash{$uniq[0]} = $match[$index];
        my $last_index = $#indexes;
        for (my $i = $last_index; $i >= 0; $i--) {
            splice @uniq, $indexes[$i], 1;
        }
        @indexes = ();
        $index++;
    }
    return \%hash;
}

anagram(\@list);
my $result = anagram(\@list);
say "$_: @{$result->{$_}}" for sort keys %$result;

При его запуске получаю такой вывод:

торс,стоп,кукла,рост,кулак,кулак,пост
торс,стоп,кукла,рост,кулак,пост
торс,стоп,кукла,рост,кулак,кулак,пост
торс,стоп,кукла,рост,кулак,пост
кукла: кукла кулак
стоп: стоп   пост
торс: торс   рост

Что некорректно.

Подскажите, пожалуйста.

  1. В строках 22 и 24 по одному раз выводим массивы:
22	    say join ",", @array;
24	    say join ",", @uniq;

Но в выводе получаем:

торс,стоп,кукла,рост,кулак,кулак,пост
торс,стоп,кукла,рост,кулак,пост
торс,стоп,кукла,рост,кулак,кулак,пост
торс,стоп,кукла,рост,кулак,пост

Вместо:

торс,стоп,кукла,рост,кулак,кулак,пост
торс,стоп,кукла,рост,кулак,пост

Почему массивы выводятся не по одному разу?

  1. В выводе получаем слова, которые разделены не одним пробелом, а случайным числом пробелов:
кукла: кукла кулак
стоп: стоп   пост
торс: торс   рост

Почему слова разделяются не одним пробелом? Как это можно исправить?

  1. В выводе пропадает слово сорт. Почему?

Спасибо за любую помощь!

Ответ на: комментарий от vel
  1. 2 вызова - два вывода.

Спасибо! Проморгал!

  1. пустые элементы

Можно ли их как-то убрать?

По третьему вопросу:

В выводе пропадает слово сорт. Почему?

Заметил, что любое последнее слово из @list не выводится в массиве @array, если поменять входные данные.

ameame2021 ()
Последнее исправление: ameame2021 (всего исправлений: 1)

Ну воот, а я думал тут однострочник…

pinus_nigra ()
Ограничение на отправку комментариев: только для зарегистрированных пользователей