IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Сортировка матрицы, динамика, файлы, драйверы
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 139
Пол: Мужской

Репутация: -  0  +


Проверрить, Все лия строки матрицы упорядочны по убыванию. Упорядочить массив по неубыванию элементов второго столбца. Сортировка вставкаими.


program laba2;
uses Crt;
type
Mas=array[1..1] of integer;
dinmas=^mas;

function takesize:integer;
var
i:integer;
begin
writeln('KO/\U4ECTBO ELEMEHTOB MACCUBA:');
repeat
readln(i);
until i>0;
takesize:=i;
end;

procedure EnterMassive(var A:dinmas; const n:integer);
var
i:integer;
begin
writeln;
writeln('BBEgUTE MACCUB:');
i:=0;
repeat
i:=i+1;
write(i,' element = ');
readln(A^[i]);
until i=n;
end;

procedure ShowMassive(var A:dinmas; const n:integer);
var
i:integer;
begin
writeln;
writeln('BBEgEHHb|U MACCUB:');
i:=0;
repeat
i:=i+1;
write(A^[i],' ');
until i=n;
writeln;
end;

procedure sorting(var A:dinmas; const n:integer);
var
j,i:integer;
endof:boolean;
add:integer;
begin
writeln;
writeln('COPTUPOBKA MACCUBA...');
for i:=2 to n do
begin
j:=i;
endof:=true;
while( j>1 ) and endof do
if (A^[j]<A^[j-1]) then
begin
add:=A^[j-1];
A^[j-1]:=A^[j];
A^[j]:=add;
j:=j-1;
end
else
endof:=false;
end;
end;


var
n:integer;
A:dinmas;

begin
clrscr;
writeln('LABA 2');

n:=takesize;
GetMem(A,sizeof(real)*n);
EnterMassive(A,n);
showMassive(A,n);

{////}
sorting(A,n);
showMassive(A,n);
Freemem(A,sizeof(real)*n);
writeln('THE END.');
readln;
end.





1 вопрос как сделать сортировку *по неубыванию элементов второго столбца. Сортировка вставкаими.*
я написал..но явно не для 2ого столбца....что-то я не понял...
и пока что-то ни как ни хочет работать *Проверрить, Все лия строки матрицы упорядочны по убыванию*
хелп


--------------------
ЗДЕСЬ МОГЛА БЫТЬ ВАША РЕКЛАМА!!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 139
Пол: Мужской

Репутация: -  0  +



{$R-}
uses Crt;
Type
TType = Word;
Type
PVector = ^TVector;
TVector = Array[1 .. 1] of TType;

PDynMatrix = ^TDynMatrix;
TDynMatrix = Array[1 .. 1] of PVector;

procedure EnterMatr(var mxDynamic: PDynMatrix; const n:integer );
Var i,j:integer;
Begin
For i := 1 To n Do
For j := 1 To n Do
read( mxDynamic^[I]^[J]);
end;

procedure ShowMatr(var mxDynamic: PDynMatrix; const n:integer );
Var i,j:integer;
Begin
For i := 1 To n Do Begin
WriteLn;
For j := 1 To n Do
Write(mxDynamic^[I]^[J]:4);
End;
End;

procedure TakeSize(var mxDynamic: PDynMatrix; const n:integer );
Var i,j:integer;
Begin
GetMem(mxDynamic, n * SizeOf(PVector));
For i := 1 To n Do
GetMem(mxDynamic^[i], n * SizeOf(TType));
end;

procedure FreeSize(var mxDynamic: PDynMatrix; const n:integer );
Var i,j:integer;
Begin
For i := 1 To n Do
FreeMem(mxDynamic^[i], n * SizeOf(TType));
FreeMem(mxDynamic, n * SizeOf(PVector));
end;


procedure SortMatr( mxDynamic: PDynMatrix; const n:integer );
Var i,j:integer;
T: PVector;
Begin
For
i := 1 To n do Begin
T := mxDynamic^[i];
j := Pred(i);
While (T^[2] < mxDynamic^[j]^[2]) and (j > 0) Do Begin
mxDynamic^[Succ(j)] := mxDynamic^[j]; Dec(j);
End;
mxDynamic^[Succ(j)] := T;
End;

Var
mxDynamic: PDynMatrix;
n, i, j: Word;

Begin
Write('n = '); ReadLn(n);


takesize(mxDynamic,n);
EnterMatr(mxDynamic,n);
clrscr;
ShowMatr(mxDynamic,n);
FreeSize(mxDynamic,n);

End.




сортировку ни пойму как заставить работать!(


--------------------
ЗДЕСЬ МОГЛА БЫТЬ ВАША РЕКЛАМА!!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 7.09.2025 12:06
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name