Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.05.2009, 21:26   #1
Александр ето я
 
Регистрация: 18.05.2009
Сообщений: 8
По умолчанию паскаль

подскажите плизз как отсортировать массив слов методом Шелла. вот мой вариант проги(но Шелл не пашет):

uses crt;
TYPE
TFILE=record
m,n: integer;
C: array[1..8, 1..9] of string[4];
end;
d=array[1..8, 1..9] of string[4];

VAR
A;
m,n,i,j,k,q,z: integer;
tipfile,u,t: string;
R: TFILE;
F: file of TFILE;
b: boolean;
curpos,flen:longint;

function BinPoisk(j,l,r: integer; t: string): integer;
VAR c: integer;
begin
BinPoisk:=0;

c:=trunc((r + l) / 2);
if (c=l) or (c=r) then
begin
if A[l,j]=t then
begin
BinPoisk:=l;
exit
end;
if A[r,j]=t then
begin
BinPoisk:=r;
exit
end;
exit;
end;


if A[c,j]=t then
begin
BinPoisk:=c;
exit
end;
if A[c,j]>t then
BinPoisk:=BinPoisk(j,l,c,t)
else
BinPoisk:=BinPoisk(j,c,r,t);
end;


Procedure Sh(Var t: d; n,h,q: integer);
Var
x:string;
i : integer;
begin
If h>0 Then
Begin
If n>h Then
begin
Sh(t,n - h,h,q);
If t[n,q] < t[n-h,q] then
Begin
x:= t[n,q];
i := n;
Repeat
t[i] := t[i - h];
i := i - h;
Until (i = h) Or (x > t[i - h,q]);
t[i,q] := x;
End;
End;
Sh(t,n,h,q Div 3);
End;
End;

BEGIN
clrscr;
{Chtenie dannyh iz faila}
write('Vvedite imya tipizirovannogo faila: ');
readln(tipfile);
assign(f, tipfile);
{$I-}
reset(f);
{$I+}

if IOResult<>0 then
begin
writeln('Oshibka pri otkritii faila!');
readkey;
exit;
end
else
curpos:=0;
flen:=filesize(f);
while (curpos<flen) do
begin
read(f, R);
writeln;
curpos:=curpos+1;
end;
close(f);

for i:=1 to 8 do
begin
for j:=1 to 9 do
begin
A[i,j]:=R.C[i,j];
m:=R.m;
n:=R.n;
end;
end;




{Vyvod ishodnoj matricy}
writeln('Ishodnaja matrica:');
for j:=1 to 9 do
begin
for i:=1 to 8 do
begin
write(' ',A[i,j]:4,' ');
read;
end;
writeln;
end;

writeln('vvedite strocy q');
readln(q);
if q>8 then writeln('net')
else
sh(A,8,9,q);
{vstavka}
{begin
for i:=2 to 8 do
begin
u:=A[i,q];
z:=1;
while (u<A[z,q]) do
z:=z+1;
for k:=i-1 downto z do
A[k+1,q]:=A[k,q];
A[z,q]:=u;
end;
end;

{end;}



{yvyod rezultata}
writeln('Otsortirovannaja matrica:');
for j:=1 to 9 do
begin
for i:=1 to 8 do
begin
write(' ',A[i,j]:4,' ');
end;
writeln;
end;
readkey;



{posledovatelny poisk}
write('Vvedite chislo dlja posledovatelnogo poiska: ');
readln(t);
b:=false;
for j:=1 to 8 do
for i:=1 to 9 do
if A[i,j]=t then
begin
writeln('Element naiden - (',i,',',j,')');
b:=true;
end;
if b=false then
writeln('Element ne naiden!');



{binarnyj poisk}
write('Vvedite chislo dlja binarnogo poiska: ');
readln(t);

b:=false;
for j:=1 to 9 do
begin
i:=BinPoisk(j,1,m,t);
if i<>0 then
begin
writeln('Element naiden - (',i,',',j,')');
b:=true;
end;
end;
if b=false then
writeln('Element ne naiden!');
readkey;
END.
Александр ето я вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Паскаль, Борланд Паскаль-в чем разница??? Vremya-Dengy Паскаль, Turbo Pascal, PascalABC.NET 13 31.05.2011 18:23
паскаль! игорек фролоff Помощь студентам 1 17.05.2009 14:49
паскаль Какаина Паскаль, Turbo Pascal, PascalABC.NET 1 01.05.2009 14:31
Паскаль rav1lya Паскаль, Turbo Pascal, PascalABC.NET 0 08.04.2009 15:17
паскаль фамил Паскаль, Turbo Pascal, PascalABC.NET 3 17.05.2008 23:23