Предметом наших изысканий станут слова, которые состоят из разных букв, то есть ни одна буква в них не повторяется. Например, ШКОЛА, УЧЕНИК, УЧЕНИЦА - это именно такие слова, а вот слово КЛАСС не годится - в нём не одна, а две буквы С.
Из этих примеров видно, что найти несколько разнобуквенных слов совсем не трудно, но наша задача - монументальная: найти все такие слова (точнее, все существительные) и наградить своим особым вниманием самое длинное из них.
Можно внимательно просмотреть словарь и выписать нужные слова, но это занятие очень долгое и утомительное. Оно больше подходит компьютеру - вот мы и составим для него небольшую программу, а уж он пусть просматривает словарь!
Благо словарь на диске у нас имеется, и мы легко загрузим его в массив строк Spisok:
const
MAX_LEN_W0RD=40;//!!! - макс. длина слоз з слозаре ! ! !
MAX DICTIONARY=300000;//! ! ! - макс. число слоз з слозаре ! ! !
var
frmMain: TfrmMain;
NAME PROG : PChar =' RasnBukvy';// - наззание программы
WordsAll : integer;//- зсего считано слоз из файла слозаря
Spisok : array [1..MAX_DICTIONARY]of string;// - массиз всех слов слозаря
FileName : string='1;// - имя файла словаря (= 11, если ни один слозарь не загружен)
Теперь мы можем последовательно брать из него по одному слову и проверять, подходит ли оно нам или нет. Самый простой способ такой. Проверяем каждую букву слова, начиная с первой и кончая предпоследней (последняя буква уж точно не совпадёт ни с одной другой буквой слова), со всеми последующими. Если совпадёт, слово не подходит, не совпадёт - переходим к следующей букве. Если в результате всех проверок ни одна буква не совпала, значит, мы нашли разнобуквицу, которую сохраняем в файле для дальнейшего использования.
В коде наш алгоритм может выглядеть так:
for i:=1 to WordsAll do begin flag:= FALSE; len:= length(spisok); for j:=1 to len-1 do
for n:= j+1 to len do begin
if spisok[i,j] = spisok[i,n] then begin //- такая буква
уже была!
flag:= TRUE; break; end
end;
if not flag then
writeln (f, spisok);
end;
Второй способ элегантнее. Для каждого слова мы заводим пустое множество, в которое будем добавлять буквы слова. Но перед этим проверим, нет ли уже в множестве такой буквы. Ну, а дальше действуем, как в первом случае:
for i:=l to WordsAll do begin
//з множестзе нет букв:
ch: = [ ] ;
flag:= FALSE;
for j:=1 to length(spisok) do begin
if (spisok [i,j] in ch) then begin //- такая буква
была!
flag:= TRUE;
break;
end
else
//добазить букву з множестзо:
include(ch, spisok[i,j]) ;
end;
if not flag then
writeln (f, spisok);
end;
Строку include(ch, spisok[i,j]); вы можете заменить так: ch:= ch +[spisok[i,j]]; Результат будет тот же самый.
Мы не только избавились от одного цикла for, но и придумали более простой алгоритм.
Да, а какое же всё-таки самое длинное слово в русском языке, в котором буквы не повторяются? Заглянем в самый конец полученного нами файла и прочитаем его:
ЧЕТЫРЁХУГОЛЬНИК
В нём 15 букв и все разные! Слово простое и всем известное, но легко ли было бы найти его без помощи компьютера? А ведь мы нашли не только это, но и вообще все разнобуквенные слова русского языка, и всего за несколько минут.
В интерфейсе программы для нас нет ничего нового и потому интересного
А программа работает так. После её запуска нажмите кнопку с папкой и загрузите словарь (на диске 3 словаря, так что выбирайте сами, или можете использовать свой собственный словарь):
// Загрузить словарь по выбору
procedure TfrmMain.sbtOpenFileClick(Sender: TObject); begin
opendialog1.DefaultExt:=’txt’;
opendialog1.Filter:=’Text files (*.txt)|*.TXT’; opendialog1.InitialDir:= extractfilepath(application.exename); opendialog1.Title:=’Загрузите новый словарь’;
if opendialog1.Execute then begin
filename:= opendialog1.filename;
loadfile;
end
else
application.MessageBox (’Вы не загрузили ^OBapb!',NAME_PROG, MB_OK); end;
В процедуре LoadFile не только загружается словарь, но и отыскиваются нужные слова. Вы можете выбрать любой из двух разработанных нами ал
горитмов. Они работают очень быстро, так что оба хороши.
// Загрузить словарь по выбору
procedure TfrmMain.sbtOpenFileClick (Sender: TObject);
begin
opendialogl.DefaultExt:='txt';
opendialogl.Filter:=1 Text files (*.txt) |*.TXT';
opendialogl.InitialDir:= extractfilepath(application.exename);
opendialogl.Title:='Загрузите нозый словарь';
if opendialogl.Execute then
begin
filename:= opendialogl.filename;
loadfile;
end
else
application.MessageBox ('Вы не загрузили слозарь!' , NAME PROG,
MB_OK) ;
end;
В процедуре LoadFile не только загружается словарь, но и отыскиваются нужные слова. Вы можете выбрать любой из двух разработанных алгоритмов. Они работают одинаково быстро.
procedure TfrmMain.LoadFile;
//имя файла хранится в переменной FileName
var
s : String;
F; TextFile;
i,j,n: integer;
ch: set of Char;
flag; boolean;
len: integer;
begin
//Открызем файл для чтения;
{$i-}
AssignFile(F,FileName);
Reset(F);
{$!+}
if iOResultoO then{ошибка при открытии файла)
begin
filename:=11;{словарь не загружен!)
application.MessageBox {'Словарь не загружен!1,NAME_PROG,
МВ_ОК);
end
else{всё нормально)
begin
WordsAll:= 0; //всего слов загружено
//считываем слоза из файла:
while not eof(f) do begin
inc(WordsAll);
Readln(F, S);
Spisok[WordsAll] ;= s;
end;
CloseFile(F);
frmMain.caption:= NAME_PROG + '['+filename+ ']
IstProtokol.Items.Add ('Загружен словарь:');
IstProtokol.Items.Add (ExtractFileName(FileName));
IstProtokol.Items.Add ('');
//записать на диск фракционный словарь:
s:= ExtractFileName(FileName);
s:= copy(s,1,length(s)-4) + 1 rb.txt';
savedialogl.FileName:= s;
if not savedialogl.Execute then exit;
assignfile(f,savedialogl.filename);
rewrite(f);
for i:=l to WordsAll do begin
//в множестве нет букв:
ch:=[];
flag:= FALSE;
for j:=1 to length(spisok) do begin
if (spisok [i,j] in ch) then begin //- такая буква уже
была!
flag:= TRUE;
break;
end
else
//добавить букву в множество:include(ch, spisok[i,j]);
ch:= ch + [spisok[i, j]] ;
end;
if not flag then
writeln (f, spisok);
end;
for i:=l to WordsAll do begin
//в множестве нет букв:
ch:= [] ;
flag:= FALSE;
for j:=1 to length(spisok) do begin
if (spisok [i,j] in ch) then begin //-
была!
flag:= TRUE;
break;
end
else
//добавить букву в множество:include(ch,
ch:= ch + [spisok[i, j]] ;
end;
if not flag then
writeln (f, spisok);
end;
такая буква
spisok[i,j])
//fori:=ltoWordsAlldobegin
//flag:= FALSE;
//len:= length(spisok);
//for j:=l to len-1do
//forn:=j+1 to len do begin
//ifspisok [i,j]=spisok [i,n] then begin //- такая
буква уже была!
//flag:= TRUE;
//break;
//end
//end;
//if not flag then
//writeln(f, spisok);
//end;
Closefile(f);
Messagebeep(0) ;
IstProtokol.Items.Add ('');
IstProtokol.Items.Add ('Записан словарь:');
IstProtokol.Items.Add (ExtractFileName(savedialogl.filename));
IstProtokol.Items.Add
end;
end;
P.S. Вы можете изучить Delphi быстрее и проще с помощью видеокурса Мастер Delphi PRO