• B правой части каждого сообщения есть стрелки и . Не стесняйтесь оценивать ответы. Чтобы автору вопроса закрыть свой тикет, надо выбрать лучший ответ. Просто нажмите значок в правой части сообщения.

Метод Шелла

  • Автор темы vihlyaev
  • Дата начала
Статус
Закрыто для дальнейших ответов.
V

vihlyaev

:sorry: Программно реализовать алгоритм сортировки Методом Шелла. Каждая запись будет в качестве ключа содержать текстовое выражение, а в качестве информативной части некоторое число.

Тестовый набор записей перед сортировкой необходимо загрузить в память из файла. Файл с тестовым набором необходимо создать. Затем при необходимости изменить у него кодировку (в зависимости от того, в какой ОС Вы осуществляете программную реализацию). После этого для каждой записи берем в качестве ключа слово из исходного файла, а для информативной части его порядковый номер в исходном тексте. Для преобразования текстового файла в набор записей также необходимо выполнить программную реализацию, которая к тому же должна предусматривать создания определенного количества записей.

Пожалуйста, помогите переделать procedure mov, на метод Шелла для этой программы.

Код:
{$r+}
uses crt,dos;
var max,Mi,Mj,bi,bj,q3:integer;
f1:file of char;
f2,f3:text;
q,q1:char;
s:string;
BOUND,t:integer;
a:array [1..30,1..1803] of char;
h_h,m_m,s_s,hund_h:word;
label B1,B2,B3,B4,B5,exit;
Function cmp(a1,a2:integer):byte;
var k:integer;
begin
cmp:=2;
for k:=1 to 20 do
begin
if ord(a[k,a1])>ord(a[k,a2]) then begin cmp:=1;break;end;
if ord(a[k,a1])<ord(a[k,a2]) then begin cmp:=0;break;end;
end;
end;
procedure mov(b1,b2:integer);
var
tmp: array [1..20] of char;
i1:integer;
begin
for i1:=1 to 20 do begin
tmp[i1]:=a[i1,b1];
a[i1,b1]:=a[i1,b2];
a[i1,b2]:=tmp[i1];
end;

end;
var i,j:integer;
begin
clrscr;
assign (f1,'D:\PO\1.txt');
assign (f2,'D:\PO\2.txt');
assign (f3,'D:\PO\3.txt');
reset (f1);
rewrite (f2);
rewrite (f3);
Mj:=1;
Mi:=1;
i:=1;
s:='1 ';
q1:='1';
while not eof(f1) do
begin
read (f1,q);
if (q <> (' ')) then
begin
if (q <> chr(10)) and (q <> chr(13)) then
s:=s+q;
a[Mi,Mj]:=q;
inc(Mi);
end
else if q1 <> ' ' then begin
if s='' then continue;
inc(i);
inc(Mj);
Mi:=1;
write (f2,s);
writeln(f2);
write (f2,i,' ');
s:='';
end;
q1:=q;
end;
{###################################################################}
{niinia ?1}
{###################################################################}
{niinia ?2}
{###################################################################}
{###################################################################}
{niinia ?3}
begin
writeln('__________________________________');
writeln('Sotirovka metodom prostih vstavok');
gettime(h_h,m_m,s_s,hund_h);
writeln('time ',h_h,':',m_m,':',s_s,'.',hund_h);
max:=1;
for j:=1803 downto 2 do
begin
for i:=1 to 1803 do
if cmp(i,max)=1 then max:=i;
mov(max,j);
end;
end;
gettime(h_h,m_m,s_s,hund_h);
writeln('time ',h_h,':',m_m,':',s_s,'.',hund_h);
writeln('__________________________________');
{###################################################################}
exit:
for mj:=1 to 1803 do
begin
for mi:=1 to 20 do
write(f3,a[Mi,Mj]);
writeln(f3);
end;
close (f1);
close (f2);
close (f3);
writeln('succesful! Press enter');
readln;
end.

:rolleyes: :please: :please: :please: :please:
 
Статус
Закрыто для дальнейших ответов.
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!