Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: Системное программирование > Тестирование словарных слов for Patterns.

Автор: junior 14.5.2005, 08:10

Привет всем, персональный для Korob2001. smile

Помогите, пожалуйста, написать программу, которая будет просматривать текстовый файл, и находить слова:
1.содержащие все 5 гласных: a, e, i, o, u.
2.начинаются и заканчиваются с a.
3.содержащие 5 и более i.
4.длинной 6 или более букв, и не содержащие: a, e, i, o, u.
5.перевертыши** (текст, одинаково читающийся от начала к концу и от конца к началу).
6.содержат 3 или более пар двойных букв.
7.содержат буквы в алфавитном порядке.
8.содержат четное количество a.
Программа должна выдавать сообщение каждый раз, когда будет найдено слово, соответствующее критерию. Сообщение должно иметь формат:
Номер критерия (1-8) “-“ и найденное слово.
Если слово подходит по нескольким критериям, оно должно печататься для каждого критерия отдельной строкой.
Я так думаю, что нужно прогонять каждое слово через 9 проверок на каждое условие, т.е. сделать цикл для прогонки каждого слова через все 8 критериев отбора.
Можно игнорировать case любой буквы.
Файл для тестирования dictionary.txt / прилагается/. Нужно иметь возможность указывать имя проверяемого файла в коммандной строке (т.е. любое имя файла).

Вот примерный output:

8 - abashed
2 - abba
5 - abba
8 - abba
7 - Abby
7 - abet
1 - aieioiuiia
2 - aieioiuiia
3 - aieioiuiia
8 - aieioiuiia
8 - azoosa
8 - Croatian
1 - Dalhousie
5 - dad
5 - deed
3 - dissimilarities
3 - institutionalizing
6 - keenness
6 - needlessness
4 - nymphs
4 - rkmpts

Помогите, пожалуйста!
Заранее СПАСИБО!!!
Добавлено @ 08:16
Sorry, файл не загрузился.
Вот часть слов из файла dictionary.txt:

Aarhus
Aaron
Ababa
aback
abaft
abandon
abandoned
abandoning
abandonment
abandons
abase
abased
abasement
abasements
abases
abash
abashed
abashes
abashing
lynches
Lyndon
Lynn
lynx
lynxes
Lyon
Lyons
Lyra
lyre
lyric
lyrics
Lysenko
Mabel
Mac
Macadamia
MacArthur
Macarthur
Macassar
Macaulay
Macaulayan
Macaulayism
Macaulayisms
Macbeth
MacDonald
Macdonald
MacDougall
Macdougall
MacDraw
mace
Yuh
Yuki
Yukon
Yuri
Yves
Yvette
Zachary
Zagreb
Zaire
Zambia
Zan
Zanzibar
zeal
Zealand
zealous
zealously
zealousness
zebra
zebras
Zeffirelli
Zeiss
Zellerbach

Автор: chaos 14.5.2005, 09:51

вот тебе экспромтом незаконченное решение

Код


#!/usr/bin/perl -w
use strict;

my ($FILE,@part_str);

$FILE = <STDIN>;
chomp $FILE;

open (FH, "$FILE") || die;
while (<FH>) {
  chomp;
  @part_str = split / /;
  foreach my $word (@part_str) {
    Filter1($word);
    Filter2($word);
    Filter3($word);
    Filter4($word);
    Filter5($word);
    Filter7($word);
    Filter8($word);
  }
}
close(FH);

#//////////FILTER1/////////////
sub Filter1 {
  my ($word, $srh) = ($_[0], "aeiou");
  foreach my $ch (split //, $srh) {
    return if (!($word =~ /$ch/i)); 
  }
  print "1 - $word\n";
}

#//////////FILTER2/////////////
sub Filter2 {
  my $word = $_[0];
  print "2 - $word\n" if ($word =~ /^a.*a$/i);
}

#//////////FILTER3/////////////
sub Filter3 {
  my $word = $_[0];
  my $m = $word;
  $word =~ s/I/i/g;
  my $pos = index $word, "i", 0;
  my $count = 0;
  $count++, $pos = index ($word, "i", $pos+1) while ($pos != -1);
  print "3 - $m\n" if ($count >=5);
}
#//////////FILTER4/////////////
sub Filter4 {
  my ($word, $srh) = ($_[0], "aeiou");
  if (length($word) >= 6) {
    foreach my $ch (split //, $srh) {
      return if ($word =~ /$ch/i); 
    }
    print "4 - $word\n";
  }
}

#//////////FILTER5/////////////
sub Filter5 {
  my $word = $_[0];
  my $drow = reverse $word;
  print "5 - $word\n" if (lc($word) eq lc($drow));
}

#//////////FILTER7/////////////
sub Filter7 {
  my $word = $_[0];
  my @word = split //, $word;
  if ($#word>0) {
    foreach (1..$#word) {
      return if (!(lc($word[$_-1]) le lc($word[$_])));
    }  
    print "7 - $word\n";
  }
}

#//////////FILTER8/////////////
sub Filter8 {
  my $word = $_[0];
  my @part = split(/a/i, $word."Q");
  print "8 - $word\n" if ((($#part % 2)==0) && ($#part>1)) ;
}

Сделаешь рефакторин и будет вообще красивый код ))
вот только что то 6 фильтр не могу придумать))), может потому-что я еще и работой занят))))

Автор: korob2001 14.5.2005, 12:26

Привет!
Вот тебе ещё одно решение.

Код


#!/usr/bin/perl -w
use strict;
my $alfa = join('', ('a'..'z'));
open( F, "< dictionary.txt" ) or die $!;
  while ( <F> ) {
    chomp;
    my( %chars, $a ) = ();
    $chars{ lc($1) }++ while (/(a|e|i|o|u)/gio);
    print "1 - $_\n" if scalar( keys %chars ) == 5;
    print "2 - $_\n" if /^a\w*?a$/io;
    print "3 - $_\n" if ( tr/iI// >= 5 );
    print "4 - $_\n" if (length >= 6) and ($_ !~ /[aeiou]/io);
    print "5 - $_\n" if lc( $_ ) eq reverse( lc( $_ ) );
    print "6 - $_\n" if /(?:(\w)\1.*?){3,}/gio;
    print "7 - $_\n" if $alfa =~ /$_/i;
    $a = $_ =~ tr/aA//;
    (($a==0)||($a % 2)) ? next : print "8 - $_\n";
  }
close( F );

В следующий раз выкладывай то, к чему пришла сама. Готовых решений больше не будет, а если и будут, то не без твоего участия.

Удачи.