Таблица в алгоритме поиск перебором заполняется динамически по мере поступления слов. Таблица в алгоритме бинарный поиск должна быть заполнена предварительно словами, и слова в таблице должны быть упорядочены лексикографически. Тестовый набор слов для отладки и сбора статистики удобно размещать в текстовом файле, в этом случае при каждом запуске программы не нужно будет набирать слова заново.
uses crt;
const
Max = 10;
type
DataArray = array [1 .. Max] of string;
var
a: DataArray; { massiv dannyh }
i, n: integer; { i-dlia indekos massiva,n-fakticheskoe kol-vo elementov }
path: string; { imia faila }
vybor, ch: char; { dlia konstrukcii [y/n] }
Rez, Flag: boolean; { Rez-rezultat chtenia dannyh, Flag-polon li massiv }
function ReadFromFile(FileName: string): boolean;
{ chtenie faila/konsoli
parametr imia faila
pustoi - konsol
vozvraschaet TRUE pri uspeshnom zavershenii }
var
f: text;
buf: string;
begin
Assign(f, FileName);
{$I-}
Reset(f);
{$I+}
if IOResult <> 0 then
begin
ReadFromFile := False;
Writeln('Problemy s failom!');
exit;
end;
repeat
inc(n);
readln(f, buf);
if buf <> '' then
a[n] := buf
else
begin
dec(n);
break;
end;
if n = Max then
begin
Flag := True;
Writeln('Massiv polnostiu zapolnen!');
break;
end;
until eof(f) = True;
Close(f);
if n > 0 then
begin
Writeln('Prochitanno slov: ', n);
ReadFromFile := True;
end
else
begin
Writeln('NE prochitanno ni odnogo slova!');
ReadFromFile := False;
end;
end;
procedure PereborSearch;
{ poisk polnym pereborom }
var
kol: integer; { kol-vo sovpadenii }
s: string;
begin
repeat
write('Nuzhno naiti: ');
readln(s);
if s = '' then
Writeln('Massiv NE soderzhit pustyh strok! Zadaite druguiu stroku.');
until s <> '';
kol := 0;
for i := 1 to n do
if a[i] = s then
begin
inc(kol);
Writeln('Pozicia: ', i, '.');
end;
if kol > 0 then
Writeln('Vsego sovpadenii: ', kol)
else if (Flag = True) or (n = Max) then
begin
Writeln('Nichego NE naideno!');
Writeln('Slovo NE mozhet byt dobavlenno - massiv zapolnen!');
end
else
begin
Writeln('Nichego NE naideno!');
inc(n);
a[n] := s;
Writeln('Slovo ', a[n], ' dobavlenno v massiv.');
end;
end;
procedure LexSort(var item: DataArray; count: integer);
{ leksikograficheskoe uporiadochivanie }
procedure QuickSort(l, r: integer; var it: DataArray);
var
i_, j: integer;
x, y: string;
begin
i_ := l;
j := r;
x := it[(l + r) div 2];
repeat
while it[i_] do
inc(i_);
while x[j] do
dec(j);
if i_ <= j then
begin
y := it[i_];
it[i_] := it[j];
it[j] := y;
inc(i_);
dec(j);
end;
until i_ > j;
if lthen QuickSort(l, j, it);
if lthen QuickSort(i_, r, it);
end;
begin
QuickSort(1, count, item);
end;
procedure BinarSearch;
{ dvoichnyi poisk }
var
left, right, middle: integer;
first, last, kol: integer;
s: string;
begin
repeat
write('Nuzhno naiti: ');
readln(s);
if s = '' then
Writeln('Massiv NE soderzhit pustyh strok! Zadaite druguiu stroku.');
until s <> '';
left := 1;
right := n;
repeat
middle := left + (right - left) div 2;
if a[middle] > s then
right := middle
else
left := middle;
until right - left <= 1;
if s = a[left] then
last := left
else if s = a[right] then
last := right
else
last := 0;
if last > 0 then
begin
first := last;
kol := 0;
repeat
if a[first] = a[last] then
begin
dec(first);
inc(kol);
end;
until a[first] <> a[last];
for i := first + 1 to last do
Writeln('Pozicia: ', i, '.');
Writeln('Vsego sovpadenii ', kol);
end
else
Writeln('Nichego NE naideno!');
end;
begin
{ osnovnaia programma }
n := 0;
textmode(259);
TextBackGround(blue);
textcolor(yellow);
repeat
clrscr;
Writeln('***********************');
Writeln('******POISK SLOVA******');
Writeln('***********************');
Writeln;
Writeln('Vyberite variant poiska: ');
Writeln('1 - Polnyi perebor');
Writeln('2 - Binarnyi poisk');
Writeln;
Writeln('ESC - EXIT');
Writeln('-----------------------');
write('...');
vybor := readkey;
until (vybor = '1') or (vybor = '2') or (vybor = #27);
if vybor = #27 then
halt;
Flag := False;
case vybor of
'1':
begin
clrscr;
Writeln('Prochitat iz faila? [y/n]');
ch := readkey;
ch := upcase(ch);
if ch = 'Y' then
begin
clrscr;
Writeln('Vvedite put k failu i ego imia (bez rashirenia): ');
readln(path);
path := path + '.txt';
Rez := ReadFromFile(path);
if Rez = False then
begin
readkey;
halt;
end;
Writeln('IN: ' + path);
Writeln('Poluchennye slova: ');
for i := 1 to n do
if i = n then
write(a[i], '.')
else
write(a[i], ', ');
Writeln;
write('Press any key to CONTINUE... ');
readkey;
repeat
Writeln;
PereborSearch;
Writeln('Prodolzhit? [y/n]');
ch := readkey;
ch := upcase(ch);
if not Flag then
begin
clrscr;
Writeln('Vsego slov: ', n);
Writeln('IN: ' + path);
Writeln('Poluchennye slova: ');
for i := 1 to n do
if i = n then
write(a[i], '.')
else
write(a[i], ', ');
Writeln;
end;
until ch = 'N';
end
else
begin
Writeln('IN: consol');
Writeln('Vvodite elementy. Konec - pustaia stroka:');
Rez := ReadFromFile('');
if Rez = False then
begin
readkey;
halt;
end;
Writeln('Poluchennye slova: ');
for i := 1 to n do
if i = n then
write(a[i], '.')
else
write(a[i], ', ');
repeat
Writeln;
PereborSearch;
Writeln('Prodolzhit? [y/n]');
ch := readkey;
ch := upcase(ch);
if not Flag then
begin
clrscr;
Writeln('Vsego slov: ', n);
Writeln('IN: ' + path);
Writeln('Poluchennye slova: ');
for i := 1 to n do
if i = n then
write(a[i], '.')
else
write(a[i], ', ');
Writeln;
end;
until ch = 'N';
end;
end;
'2':
begin
clrscr;
Writeln('Prochitat iz faila? [y/n]');
ch := readkey;
ch := upcase(ch);
if ch = 'Y' then
begin
clrscr;
Writeln('Vvedite put k failu i ego imia (bez rashirenia): ');
readln(path);
path := path + '.txt';
Rez := ReadFromFile(path);
if Rez = False then
begin
readkey;
halt;
end;
Writeln('IN: ' + path);
Writeln('Poluchennye slova: ');
LexSort(a, n);
for i := 1 to n do
if i = n then
write(a[i], '.')
else
write(a[i], ', ');
Writeln;
write('Press any key to CONTINUE... ');
Writeln;
readkey;
repeat
Writeln;
BinarSearch;
LexSort(a, n);
Writeln('Prodolzhit? [y/n]');
ch := readkey;
ch := upcase(ch);
until ch = 'N';
end
else
begin
Writeln('IN: consol');
Writeln('Vvodite elementy. Konec - pustaia stroka:');
Rez := ReadFromFile('');
if Rez = False then
begin
readkey;
halt;
end;
Writeln('Poluchennye slova: ');
LexSort(a, n);
for i := 1 to n do
if i = n then
write(a[i], '.')
else
write(a[i], ', ');
Writeln;
write('Press any key to CONTINUE... ');
readkey;
repeat
Writeln;
BinarSearch;
Writeln('Prodolzhit? [y/n]');
ch := readkey;
ch := upcase(ch);
until ch = 'N';
end;
end;
end;
write('Pres any key to EXIT... ');
readkey;
end.