Модераторы: volvo877, Snowy, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Процедуры и функции в паскале 
:(
    Опции темы
neomax38
Дата 5.1.2011, 07:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 27
Регистрация: 15.12.2010

Репутация: нет
Всего: нет



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



Это сообщение отредактировал(а) neomax38 - 5.1.2011, 07:28
PM MAIL   Вверх
mes
Дата 5.1.2011, 09:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


любитель
****


Профиль
Группа: Участник Клуба
Сообщений: 7954
Регистрация: 14.1.2006

Репутация: нет
Всего: 250



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



--------------------
PM MAIL WWW   Вверх
neomax38
Дата 7.1.2011, 08:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 27
Регистрация: 15.12.2010

Репутация: нет
Всего: нет



Цитата

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


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


Код

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));

PM MAIL   Вверх
mes
Дата 7.1.2011, 10:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


любитель
****


Профиль
Группа: Участник Клуба
Сообщений: 7954
Регистрация: 14.1.2006

Репутация: нет
Всего: 250



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


Код

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



Это сообщение отредактировал(а) mes - 7.1.2011, 10:41


--------------------
PM MAIL WWW   Вверх
neomax38
Дата 7.1.2011, 10:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 27
Регистрация: 15.12.2010

Репутация: нет
Всего: нет



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

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

PM MAIL   Вверх
volvo877
Дата 8.1.2011, 23:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116



Цитата(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 а не два вектора одинакового размера, один из которых почти наполовину пустой. Паскаль прекрасно позволяет обойтись без выделения лишней памяти)...

Это сообщение отредактировал(а) volvo877 - 9.1.2011, 11:43
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »


 




[ Время генерации скрипта: 0.3103 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.