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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 14.11.2010, 11:52   #1
NewbieStudent
 
Регистрация: 14.11.2010
Сообщений: 4
По умолчанию Сортировка матрицы методом Шелла

Тут на днях озадачили простым заданием: Отсортировать столбцы произвольной матрицы по убыванию методом Шелла. Лекцию пропустил, а с помощью интернета в сути так разобраться и не смог. Будьте добры, разжуйте как для дураков эту тему. ):
NewbieStudent вне форума Ответить с цитированием
Старый 14.11.2010, 12:42   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

А так?:http://delphiworld.narod.ru/base/shell_sort.html
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 14.11.2010, 12:44   #3
NewbieStudent
 
Регистрация: 14.11.2010
Сообщений: 4
По умолчанию

Цитата:
Сообщение от Stilet Посмотреть сообщение
Спасибо большое, теперь разобрался.
NewbieStudent вне форума Ответить с цитированием
Старый 06.12.2010, 15:19   #4
NewbieStudent
 
Регистрация: 14.11.2010
Сообщений: 4
По умолчанию

Вообщем заброковали мою работу. Сказали, что необходимо чтобы сортировка Шелла была переделана под матрицу из этого программного кода:

Код:
program shell_sort;
const n=18;
a:array[1..n] of integer
=(18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1);
var ii,m,x,s,p,t,k,r,i,j: integer;
begin
t:= trunc(ln(n)/ln(2));
repeat
t:= t-1;
k:= (1 shl t)-1;
p:= n mod k;
s:= n div k;
if p=0 then p:= k
else s:= s+1;
writeln(k,'-сортировка');
for i:= 1 to k do {берем и длинные, и короткие
подпоследовательности}
begin
if i= p+1 then s:= s-1; (для коротких - уменьшаем длину}
for j:= 1 to s-1 do {метод ПрВст с шагом k}
if a[i+(j-1)*k]>a[i+j*k]
then begin x:= a[i+j*k];
m:= i+(j-1)*k;
while (m>0) and (a[m]>x) do
begin a[m+k]:= a[m];
m:= m-k;
end;
a[m+k]:= x;
end;
for ii:= 1 to n do write(a[ii],' ');
writeln;
end;
until k=1;
end.
То есть такой тип их не устроил:
Код:
uses crt;
var a: array[1..25, 1..25] of integer;
	i, j, n, m, z, x, incr, l, k, tmp, t, p: integer;

begin
clrscr;
randomize;
writeln('vvedite chislo strok');
readln(n);
writeln('vvedite chislo stolbtsov');
readln(m);

{zapolnenie matrix}
for i := 1 to n do
begin
for j := 1 to m do
a[i, j] := random(25);
end;
textcolor(red);
writeln('ishodnaia matritsa');
textcolor(white);
for i := 1 to n do
begin
for j := 1 to m do
write(a[i, j], ' ');
writeln;
end;

{sortirovka matrix}
for i := 1 to n do
begin
for j := 1 to m do
begin
{sortirovka shella}
incr := n div 2;
while incr > 0 do
begin
for k := incr + 1 to n do
begin
l := k - incr;
while l > 0 do
if a[l, j] < a[l + 1, j] then
begin
tmp := a[l, j];
a[l, j] := a[l + 1, j];
a[l + 1, j] := tmp;
l := l - incr
end
else
l := 0
end;
incr := incr div 2;
end; {tsikl sortirivki zaconchilsa}
end;
end; {konets vsego tsikla}
textcolor(red);
writeln('novi matrix');
textcolor(white);
for i := 1 to n do
begin
for j := 1 to m do
write(a[i, j], ' ');
writeln;
end;

readln;
end.
Бился целую неделю, но переделать 1 тип под матрицу не смог. Путаюсь в переменных хоть ты тресни. Помогите под матрицу эту ерундистику переделать. Уже не могу...
NewbieStudent вне форума Ответить с цитированием
Старый 06.12.2010, 18:43   #5
NewbieStudent
 
Регистрация: 14.11.2010
Сообщений: 4
По умолчанию

Код:
program shell_sort;
uses crt;
var ii,m,s,p,t,k,r,i,j,z,x,n,w: integer;
    MTRX:array[1..25,1..25] of integer;
begin
clrscr;
randomize;
textcolor(red);
writeln('‚ўҐ¤ЁвҐ зЁб«® бва®Є');
readln(n);
textcolor(red);
writeln('‚ўҐ¤ЁвҐ зЁб«® бв®«Ўж®ў');
readln(w);

textcolor(red);

for i:=1 to n do
 begin
   for j:=1 to w do
    begin
     MTRX[i,j]:=random(10)-5;
     write(MTRX[i,j]:7);
    end;
   writeln;
 end;

for z:=1 to n do
begin
 t:=trunc(ln(n)/ln(2));
	repeat
		t:=t-1;
		k:=(1 shl t)-1;
		p:=n mod k;
		s:=n div k;
  if p=0 then p:=k
  else s:=s+1;

   for i:=1 to k do
   begin
    if i=p+1 then s:=s-1;
    for j:= 1 to s-1 do
     if MTRX[i+(j-1)*k,z]>MTRX[i+j*k,z]
      then begin x:=MTRX[i+j*k,z];
       m:=i+(j-1)*k;
       while (m>0) and (MTRX[m,z]>x) do
         begin MTRX[m+k,z]:= MTRX[m,z];
         m:=m-k;
         end;
       MTRX[m+k,z]:=x;
      end;
end;
	until k=1;
end;
writeln;
writeln;
for i:=1 to n do
begin
 for j:=1 to w do
  write(MTRX[i,j]:5);
 writeln;
end;
readln;
end.
Вроде бы получилось
NewbieStudent вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сортировка Шелла и Шейкер-сортировка AleksandrMakarov Паскаль, Turbo Pascal, PascalABC.NET 11 11.03.2012 12:18
Сортировка Шелла QuadroX Фриланс 1 29.05.2010 03:52
Сортировка методом Шелла Nostalgia Помощь студентам 0 12.04.2010 14:13
сортировка Шелла pilot76 Помощь студентам 2 17.08.2009 18:05
Помогите решить задачу в C++ на массивы + сортировка методом Шелла Exact Помощь студентам 2 18.06.2009 14:44