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

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

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

> Упорядочивание матрицы или одном. массивов.
сообщение
Сообщение #1





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

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


Собственно требуется упорядочить 4 одномерных массива, 4 массива получаются путём создания их из 4рех первых строк матрицы.
Нужно упорядочить их по убыванию.
Читал это Методы сортировок
Пробовал и способом вставки и пузырьковым методом, видимо я немного криворукий...
Прошу вашей помощи) Сделал всю лабу, осталось всего лишь эта мелочь...
Сама прога.
Program xD;
Uses Graph, Crt;
const
Nmax = 10; {Максимальная размерность матрицы}
type
Matrix = array [1..Nmax, 1..Nmax] of real;
Vector = array [1..Nmax] of real;
var
G, H : Matrix;
a, b, c, d, x, z: Vector;
MaxX, MaxY, Driver, Regim,
font, i, j, M, t, k, N: integer;
buf, max:real;
ch: char;
s: string;
sv: boolean;
f: text;
Procedure oform; {Вывод фона программы}
begin
SetFillStyle(1, 15);
Bar(0, 0, MaxX, MaxY);
SetFillStyle(1, 1);
Bar(0, 0, MaxX, 25);
Bar(0, MaxY - 25, MaxX, MaxY);
SetLineStyle(0, 0, 1);
SetTextStyle(font, 0, 5);
SetTextJustify(0, 0);
SetColor(15);
OutTextXY(300, 20, 'Вариант 1');
SetColor(12);
OutTextXY(10, MaxY - 7, 'F1');
OutTextXY(130, MaxY - 7, 'F2');
OutTextXY(240, MaxY - 7, 'F3');
OutTextXY(390, MaxY - 7, 'F4');
OutTextXY(550, MaxY - 7, 'Esc');
SetColor(15);
OutTextXY(40, MaxY - 8, 'Клавиатура');
OutTextXY(160, MaxY - 8, 'Рандом');
OutTextXY(270, MaxY - 8, 'Загрузить');
OutTextXY(420, MaxY - 8, 'Преобразовать');
OutTextXY(590, MaxY - 8, 'Выход');
end;
Procedure INPUT; {Ввод матрицы}
var
i, j: integer;
begin
Write('Введите размерность матрицы (M*N, M>3): ');
ReadLn(M, N);
WriteLn('Ввод матрицы');
for i := 1 to M do
for j := 1 to N do
begin
Write('G(', i, ',', j, ')=');
ReadLn(G[i, j]);
end;
end;
procedure rand; {Генератор случайных значений}
var
i, j: integer;
begin
write('Введите размерность матрицы (M*N, M>3: ');
readln(M,N);
randomize;
for i:=1 to m do
for j:=1 to n do
G[i,j]:=random(50);
end;
Function DivAMin(var A: Matrix; M, N: integer;var st:string): real;
{Вычисление минимального элемента каждого столбца и умножение на
этот элемент текущий столбец}
var
min: real;
i, j: integer;
begin
DivAMin := 0;
for j:=1 to n do
begin
min:=A[1,j];
for i:=1 to m do
if A[i,j]<min
then min:=A[i,j];
for i:=1 to m do
begin
z[j]:=min;
A[i,j]:=A[i,j]*min;
end;
end;
DivAMin:=n;
end;
begin
font := InstallUserFont('small');
Driver := VGA; Regim := VGAHi;
InitGraph(Driver, Regim, '');
MaxX := GetMaxX; MaxY := GetMaxY;
oform;
sv := False;
DirectVideo := False;
repeat
ch := ReadKey;
case ch of
#59: begin {Клавиатура}
RestoreCRTMode;
INPUT;
sv := True;
SetGraphMode(VGAHi);
oform;
SetColor(0);
end;
#60: begin {Рандом}
RestoreCRTMode;
rand;
sv := True;
SetGraphMode(VGAHi);
oform;
setcolor(0);
end;
#61: begin {Загрузить}
SetFillStyle(1, 15);
Bar(0, 26, MaxX, MaxY - 26);
Window(2, 4, 78, 24);
Write('Имя файла: ');
Readln(s);
{$I-} Assign(f, s); Reset(f); {$I+}
if IOResult <> 0 then Continue;
ReadLn(f, M, N);
for i := 1 to M do
begin
for j := 1 to N do
Read(f, G[i, j]);
ReadLn(f);
end;
Close(f);
sv := True;
SetFillStyle(1, 15);
Bar(0, 26, MaxX, MaxY - 26);
end;
#62: begin {Преобразовать}
if not sv then Continue;
SetColor(0);
SetFillStyle(1, 15);
Bar(0, 26, MaxX, MaxY - 26);
Assign(f, 'v1'); Rewrite(f);
WriteLn(f, 'Исходная матрица');
for i := 1 to m do
begin
for j := 1 to n do
Write(f, G[i, j]:8:1);
WriteLn(f);
end;
DivAMin(G, M, N, S);
writeln(f, 'Минимумы');
for i:=1 to n do
write(f,z[i]2.gif1,' ');
writeln(f);
WriteLn(f, 'Преобразованная матрица');
for i := 1 to m do
begin
for j := 1 to n do
Write(f, G[i, j]:8:2);
WriteLn(f);
end;
for i := 1 to n do
begin
a[i] := G[1, i]; b[i] := G[2, i];
c[i] := G[3, i]; d[i] := G[4, i];
end;
WriteLn(f, 'Вектор из 1-ой строки');
for j := 1 to N do
Write(f, a[j]:8:2);
WriteLn(f);
WriteLn(f, 'Вектор из 2-ой строки');
for j := 1 to N do
Write(f, b[j]:8:2);
WriteLn(f);
WriteLn(f, 'Вектор из 3-ой строки');
for j := 1 to N do
Write(f, c[j]:8:2);
WriteLn(f);
WriteLn(f, 'Вектор из 4-ой строки');
for j := 1 to N do
Write(f, d[j]:8:2);
WriteLn(f);
Close(f);
Reset(f);
j := 40;
while not EOF(f) do
begin
ReadLn(f, s);
OutTextXY(10, j, s);
j := j + 11;
end;
Close(f);
end;
end;
until ch = #27;
CloseGraph;
end.


Добавлено через 1 мин.
Как я понял, можно упорядочить уже векторы, или матрицу до создания векторов, но и так и так у меня ничего не получилось, увы...(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской
Ада: Разработчик
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик

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


Цитата
Сделал всю лабу, осталось всего лишь эта мелочь...
Вообще-то с "этой мелочи" нужно начинать делать работу. Сначала - пишешь функционал, потом - наводишь красоту. Ты пошел другим путем. Навел красоту? Гордись. Теперь у тебя есть никому не нужная, зато жутко красивая (наверное, я не запускал, но судя по размеру исходника - она обязана быть красивой) программа. Только это тебе не поможет: программа должна выполнять свою работу, а не утомлять зрение.

Цитата
Собственно требуется упорядочить 4 одномерных массива
Собственно, там, в FAQ-е есть для этого процедура. Для твоего случая она будет выглядеть так:

Procedure Bubble(Var ar: Vector; n: integer);
Var
i, j: Integer;
T: real;
Begin
For i := 1 To n Do
For j := n DownTo i+1 Do
If ar[Pred(j)] < ar[j] Then
Begin
T := ar[Pred(j)]; ar[Pred(j)] := ar[j]; ar[j] := T
End
End;
, передавай в нее свои массивы - они будут упорядочены. Если тебе нужно их каким-то специальным образом создавать массивы из матрицы - то уточняй, каким именно. А еще лучше - привести формулировку задачи, ибо ты написал все, что угодно, только не то, что нужно для понимания задачи...

P.S. ТЫ что, шрифт SMALL сам написал? Нет? А почему же используется InstallUserFont, а не RegisterBGIfont? (это просто бросилось в глаза, я программу даже не компилировал...)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 





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