Помогите с процедурами и функциями в паскале

[neomax38]

Вот задание:
Даны векторы A[10], B[18]. У каждого вектора, компоненты которого не образуют неубывающей последовательности, отрицательные компоненты заменить максимальным элементом.

Сделал отрицательные компоненты заменить максимальным элементом:

procedure GetMaxSwap (var M: Massiv; count: integer);
var
i: integer;
max: integer;
begin
max := M[1];
for i := 1 to count do
if M[i] > max then max := M[i];
for i := 1 to count do
if M[i] < 0 then M[i] := max;
end;

 

[hosm]

Если компоненты образуют неубывающую последовательность, то вектор отсортирован по возрастанию, т.е. каждый последующий элемент не меньше (т.е. больше либо равен) предыдущим.
Если это условие не выполняется, т.е. есть элемент, который меньше какого-то из предыдущих, то надо выполнять описанную вами GetMaxSwap. Это сложно написать - трудно сравнить соседние элементы массива?

 

[neomax38]

сложно

 

[hosm]

for i := 2 to count do
if M[i-1] > M[i] then begin // есть элемент, который меньше какого-то из предыдущих
GetMaxSwap(M, count); //отрицательные компоненты заменить максимальным элементом
break; // Выход, больше проверять нечего
end;

 

[neomax38]

И это вся программа?

 

[hosm]

это кусок кода, реализующий это:

У каждого вектора, компоненты которого не образуют неубывающей последовательности, отрицательные компоненты заменить максимальным элементом.

обзовешь его procedure CheckAndReplace(var M: Massiv; count: integer);
допишешь var i: integer;
и вызовешь в своей программе, передав каждый массив и кол-во его элементов =)

 

[neomax38]

Вот задание:
Даны векторы A[10], B[18]. У каждого вектора, компоненты которого не образуют неубывающей последовательности, отрицательные компоненты заменить максимальным элементом.

2 процедуры, теперь надо их вызвать, передав каждый массив и кол-во его элементов =)
Подскажите как сделать, не силен в массивах(

procedure GetMaxSwap (var M: Massiv; count: integer);
var
i: integer;
max: integer;
begin
max := M[1];
for i := 1 to count do
if M[i] > max then max := M[i];
for i := 1 to count do
if M[i] < 0 then M[i] := max;
end;
procedure CheckAndReplace(var M: Massiv; count: integer);
for i := 2 to count do
if M[i-1] > M[i] then begin // есть элемент, который меньше какого-то из предыдущих
GetMaxSwap(M, count); //отрицательные компоненты заменить максимальным элементом
break; // Выход, больше проверять нечего
end;

 

[mss]

icq 169527143

 

[hosm]

теперь надо их вызвать, передав каждый массив и кол-во его элементов

program baseprogram;
type Massiv = array [1..20] of integer;
var
a: Massiv;
b: Massiv;

// тут вставить процедуры, описанные тобой
// тут могут быть еще некоторые переменные и процедуры, не описанные тобой
begin

// тут будет код заполнения массивов

CheckAndReplace(A, 10); // обработка массива A
CheckAndReplace(B, 18); // обработка массива B

// тут будет код вывода результирующих массивов
end.

следующий вопрос - про ввод или вывод массива? =)

Добавлено: В описании типа 20 - мне просто понравилось такое число.
По задаче достаточно не меньше 18, можете именно 18 поставить )))

 

[neomax38]

Вот задание:
Даны векторы A[10], B[18]. У каждого вектора, компоненты которого не образуют неубывающей последовательности, отрицательные компоненты заменить максимальным элементом.

Его надо сделать по примеру.

program Matrix_work;
uses crt;
const
n=5; {максимальный порядок матрицы}
type
matrix=array[1..n,1..n] of real;
var
row : integer; {Порядок матриц}
c,t : matrix; {Исходные матрицы}
f : matrix; {Результирующая матрица}
r,tt : matrix; {Рабочие матрицы}
i,j : integer;
kc,kt : integer;
s : string;
{ Описания подпрограмм }
{1. Описание функции koln }
{ Функция определения количества отрицательных элементов в матрице}
function koln(a:matrix; m:integer):integer;
var
i,j,mx : integer;
begin
mx:=0;
for i:=1 to m do
for j:=1 to m do
if a[i][j]<0 then mx:=mx+1;
koln:=mx;
end;
{ 2. Описание процедуры умножения матриц umn(a,b,m,r). r=a*b }
procedure umn(a, b:matrix; m:integer; var r:matrix);
var
i,j,k:integer;
z:real;
begin
for i:=1 to m do
for j:=1 to m do
begin
z:=0;
for k:=1 to m do
z:=z+ a[i,k]*b[k,j];
r[i,j]:=z;
end;
end;
{ 3. Описание процедуры trans. r=b транспонированная }
procedure trans( b:matrix; m:integer; var r:matrix);
var
i,j:integer;
begin
for i:=1 to m do
for j:=1 to m do
r[i,j]:=b[j,i];
end;
{ 4. Описание процедуры input – ввод квадратной матрицы A[m,m] }
procedure input( var a:matrix; m:integer);
var
i,j:integer;
begin
clrscr;
writeln(' ввод матрицы порядка ',m);
writeln(' Ввод каждого элемента завершайте нажатием EnteR');
for i:=1 to m do
begin
gotoxy(1,i+2); write(' row #',i);
for j:=1 to m do
begin
gotoxy(j*6+8,i+2); readln(a[i,j])
end;
end;
end;
{ 5. Описание процедуры print. Вывод квадратной матрицы A[m,m] }
procedure print( a:matrix; m:integer);
var
i,j:integer;
begin
for i:=1 to m do
begin
for j:=1 to m do
write(a[i,j]:8:2);
writeln
end;
end;
begin
{ главный модуль }
clrscr;
{ввод порядка матриц с контролем}
repeat
write('Read row '); readln(row);
until (row>0)and(row<=n);
writeln(' ввод матрицы С ');
input (c,row);
writeln(' ввод матрицы T ');
input (t,row);
writeln(' Матрица С');
print(C,row);
kc:= koln(c,row);
writeln('count of negative in C ',kc);
writeln(' Матрица T');
print(T,row);
kt:= koln(t,row);
writeln('count of negative in T ',kt);
if kc>kt then
begin
{ Вычисление матрицы F }
umn(c, t,row,r);
trans(r, row,f);
s:='=(c*t) transp';
end else
begin
{ f = c транспонированная, умножена на t }
s:='=C транспонированная, умножена на t ';
trans(c, row,r);
umn(r, t,row,f);
{ Вычисленa матрицa F}
end;
writeln(' Матрица F'+s);
print(f,row);
readln;
end.

Я написал:

Program procedur;
Uses CRT;
const
n=5; {максимальный порядок матрицы}
type
matrix=array[1..n,1..n] of real;
var
row: integer; {Порядок матриц}
c,t : matrix; {Исходные матрицы}
f,ff : matrix; {Результирующая матрица}
r,tt : matrix; {Рабочие матрицы}
i,j : integer;
kc,kt : integer;

{ 4. Описание процедуры input – ввод квадратной матрицы A[m,m] }
procedure input( var a:matrix; m:integer);
var
i,j:integer;
begin
clrscr;
writeln(' ввод матрицы порядка ',m);
writeln(' Ввод каждого элемента завершайте нажатием EnteR');
for i:=1 to m do
begin
gotoxy(1,i+2); write(' row #',i);
for j:=1 to m do
begin
gotoxy(j*6+8,i+2); readln(a[i,j])
end;
end;
end;

{ 5. Описание процедуры print. Вывод квадратной матрицы A[m,m] }
procedure print( a:matrix; m:integer);
var
i,j:integer;
begin
for i:=1 to m do
begin
for j:=1 to m do
write(a[i,j]:8:2);
writeln
end;
end;


procedure GetMaxSwap (var M: matrix; count: integer);//отрицательных компонентов
var
i: integer;
max: integer;
begin
max := M[1];
for i := 1 to count do
if M[i] > max then max := M[i];
for i := 1 to count do
if M[i] < 0 then M[i] := max;
end;

begin
procedure CheckAndReplace(var M: matrix; count: integer);
for i := 2 to count do
if M[i-1] > M[i] then begin // есть элемент, который меньше какого-то из предыдущих
GetMaxSwap(M, count); //отрицательные компоненты заменить максимальным элементом
break; // Выход, больше проверять нечего
end;
end;
{ главный модуль }
clrscr;

С выводом проблемы.Как выводить, не понимаю.
+ в процедуре GetMaxSwap массив имеет другое кол-во размерности.
Подскажите Как доделать.

 

[neomax38]

Вот задание:
Даны векторы A[10], B[18]. У каждого вектора, компоненты которого не образуют неубывающей последовательности, отрицательные компоненты заменить максимальным элементом.

Ошибка не совпадения типа... Подскажите что непрвильно.

Program procedur;
Uses CRT;
type mas=array[1..20,1..20] of integer;

Procedure Vvod(k:byte;var x:mas);{ввод}
var i,j:integer;
Begin
for i:=1 to k do
for j:=1 to k do
begin
write('Введите элемент [', i,',', j,']= ');
readln(x[i,j]);
end;
end;

Procedure Vyvod(k:byte;var x:mas);{вывод}
var i,j:integer;
begin
for i:=1 to k do
begin
for j:=1 to k do
write(x[i,j]:4);
writeln;
end;
end;

procedure GetMaxSwap (var M: mas; count: integer);{//отрицательных компонентов }
var
i: integer;
max: integer;
begin
max := M[1];
for i := 1 to count do
if M[i] > max then max := M[i];
for i := 1 to count do
if M[i] < 0 then M[i] := max;
end;

begin
procedure CheckAndReplace(var M: mas; count: integer);
for i := 2 to count do
if M[i-1] > M[i] then begin // есть элемент, который меньше какого-то из предыдущих
GetMaxSwap(M, count); //отрицательные компоненты заменить максимальным элементом
break; // Выход, больше проверять нечего
end;
end;


var c,t,f:mas;
n:integer;

BEGIN
clrscr;
writeln('Матрица А:');
Vvod(10,C);
Vyvod(10,C);
writeln('Матрица В:');
Vvod(18,T);
Vyvod(18,T);

writeln('вывод ',CheckAndReplace(n,C));

end.

Нашел ошибку
Вот исправленный. но не срабатывает процедура CheckAndReplace, пишет тип фактического элемента отличается от типа формального элемента

Program procedur;
Uses CRT;
type mas=array[1..200,1..200] of real;

Procedure Vvod(k:byte;var x:mas);{ввод}
var i,j:integer;
Begin
for i:=1 to k do
for j:=1 to k do
begin
write('Введите элемент [', i,',', j,']= ');
readln(x[i,j]);
end;
end;

Procedure Vyvod(k:byte;var x:mas);{вывод}
var i,j:integer;
begin
for i:=1 to k do
begin
for j:=1 to k do
write(x[i,j]:4);
writeln;
end;
end;

procedure GetMaxSwap (var M: mas; count: integer);//отрицательных компонентов
var
i,j: integer;
max: real;
begin
max := M[1,1];
for i := 1 to count do
if M[i,j] > max then max := M[i,j];
for i := 1 to count do
if M[i,j] < 0 then M[i,j] := max;
end;

procedure CheckAndReplace(var M: mas; count: integer);
var
i,j: integer;
begin
for i := 2 to count do
if M[i-1,j] > M[i,j] then begin // есть элемент, который меньше какого-то из предыдущих
GetMaxSwap(M, count); //отрицательные компоненты заменить максимальным элементом
break; // Выход, больше проверять нечего
end;
end;


var c,t,f:mas;
n:real;

BEGIN
clrscr;
writeln('Матрица А:');
Vvod(10,C);
Vyvod(10,C);
writeln('Матрица В:');
Vvod(18,T);
Vyvod(18,T);

writeln('вывод ',CheckAndReplace(n,C));

end.

 

[hosm]

первым параметром там массив передается, а потом кол-во элементов..

procedure CheckAndReplace(var M: mas; count: integer);

writeln('вывод ',CheckAndReplace(n,C));

надо CheckAndReplace(C, n);

а зачем по 200 элементов?

type mas=array[1..200,1..200] of real;

 

[neomax38]

Вот задание:
Даны векторы A[10], B[18]. У каждого вектора, компоненты которого не образуют неубывающей последовательности, отрицательные компоненты заменить максимальным элементом.

Требуется заменить процедуры на вот эти функции:

function поиска максимального: real;
function проверки не образования неупор.посл-ти :boolean

Program procedur;
Uses CRT;
type mas=array[1..18] of real;

Procedure Vvod(k:byte;var x:mas);{ввод}
var i:integer;
Begin
for i:=1 to k do
begin
write('Введите элемент [', i,']= ');
readln(x[i]);
end;
end;

Procedure Vyvod(k:byte; x:mas);{вывод}
var i:integer;
begin
for i:=1 to k do
write(x[i]:4);
end;



procedure GetMaxSwap (var M: mas; count: integer);//максимальный елемент
var
i: integer;
max: real;
begin
max := M[1];
for i := 1 to count do
if M[i] > max then max := M[i,j];
for i := 1 to count do
if M[i] < 0 then M[i,j] := max;
end;

procedure CheckAndReplace(var M: mas; count: integer);
var
i: integer;
begin
for i := 2 to count do
if M[i-1] > M[i] then begin // есть элемент, который меньше какого-то из предыдущих
GetMaxSwap(M, count); //отрицательные компоненты заменить максимальным элементом
break; // Выход, больше проверять нечего
end;
end;


var c,t,f:mas;
n:integer;

BEGIN
clrscr;
writeln('Матрица А:');
Vvod(10,C);
Vyvod(10,C);
writeln('Матрица В:');
Vvod(18,T);
Vyvod(18,T);

writeln('вывод ',CheckAndReplace(C,n));

end.

 

[Dock1100]

Ссылка скрыта от гостей

 

[hosm]

Dock1100 забей. Я редко так говорю, обычно стараюсь помогать. Но этот *добрый человек* уже 5ю тему по своей задаче открывает - блин, ну надо ж хоть немного совесть иметь! Я вроде их все соединила. И он нифига не понимает, за это время можно было уже 10 подобных задач решить.
Ну, если совсем нечего делать - пиши код.

 

[neomax38]

Можно было это во второй раз сказать Что бы я не моздавал тем новых