Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > Процедуры и функции в паскале

Автор: neomax38 5.1.2011, 07:26

Вот задание:
Даны векторы 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.

Автор: mes 5.1.2011, 09:29

ну и в чем проблема ?
вместо procedure пишите function
из аргументов функции выкидываете var M,
за аргументами указываете тип возвращаемого значения (через двоеточие)
а в теле функции меняете все M на имя функции..

Автор: neomax38 7.1.2011, 08:51

Цитата

Какой функцией заменить Массив М ?

Код


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;
function GetMaxSwap (var M: mas; count: integer):real;//отрицательных компонентов
var
i: integer;
max: real;
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;
function CheckAndReplace(var M: mas; count: integer):boolean;
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));

Автор: mes 7.1.2011, 10:37

я там немного запутал Вас.. так как по описанию подумал, что процедура у Вас готовая, и нужно переделать на функцию..

Код


function GetMaxSwap (var M: mas; count: integer):real;//отрицательных компонентов
var
i: integer;
max: real;
begin
  max := M[1];
  for i := 2 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;

  GetMaxSwap := max;

end;

второй по аналогии..
впоследствии можно избавиться от лишней локальной переменной..

P.S. это пример как сделать функцию.. а что там внутри менять сами смотрите.. smile

Автор: neomax38 7.1.2011, 10:42

т.е надо все вернуть обратно

Добавлено через 2 минуты и 20 секунд
Выводится что то непонятное

Автор: volvo877 8.1.2011, 23:03

Цитата(neomax38 @ 7.1.2011, 09:42

)

Выводится что то непонятное

Что тут может быть непонятного?

Код


Program procedur;
Uses CRT;

procedure Vvod (var X : array of real);
var i : integer;
begin
   for i := Low(X) to High(X) do
   begin
      write ('Введите элемент [', i + 1, ']= ');
      readln (X[i]);
   end;
end;

procedure Vyvod (const X : array of real);
var i : integer;
begin
   for i := Low(X) to High(X) do
      write (X[i]:5:1);
   writeln;
end;

function IsNonDesc (const X : array of real) : boolean;
var
   i : Integer;
   b : Boolean;
begin
   b := true;
   for i := Low(X) to High(X) - 1 do
     b := b and (X[i] <= X[i + 1]);
   IsNonDesc := b;
end;

function GetMax (const X : array of real) : real;
var
   i, index : Integer;
begin
   index := Low(X);
   for i := Low(X) + 1 to High(X) do
      if X[i] > X[index] then index := i;
   GetMax := X[index];
end;

procedure Replace (var X : array of real; max : real);
var
   i : integer;
begin
   for i := Low(X) to High(X) do
      if X[i] < 0 then X[i] := max;
end;

const
   Size_A = 10;
   Size_B = 18;
var
   A : array[1 .. Size_A] of real;
   B : array[1 .. Size_B] of real;

BEGIN
   clrscr;
   writeln ('До :');
   writeln ('Матрица А:');
   Vvod (A);
   Vyvod (A);
   writeln ('Матрица В:');
   Vvod (B);
   Vyvod (B);

   writeln ('После :');
   writeln ('Матрица А:');
   if IsNonDesc (A) then Replace (A, GetMax(A));
   Vyvod(A);

   writeln ('Матрица В:');
   if IsNonDesc (B) then Replace (B, GetMax(B));
   Vyvod(B);
end.

(не надо привязываться к подобному описанию mas = array[1 .. 18] of real, и все строить на нем. У тебя в задании ясно сказано, что тебе даны векторы размером 10 и 18 а не два вектора одинакового размера, один из которых почти наполовину пустой. Паскаль прекрасно позволяет обойтись без выделения лишней памяти)...