Показать сообщение отдельно
Старый 17.05.2013, 09:53   #1 (permalink)
К. Иванова
Новичок
 
Регистрация: 16.05.2013
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Помогите найти ошибку в задаче на Паскале

Проверьте пожалуйста программу и помогите где неправильно. Написана на Паскале.

Вот условие задания!!!
Нужно создать программу, в которой можно решить следующие программы. Дан вектор – одномерный числовой массив.

Задача 1. Найти среднее арифметическое отрицательных элементов массива, предшествующих первому положительному элементу. Если по какой-либо причине вычислить среднее арифметическое не удается, выдать об этом сообщение с указанием причины.

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

Задача 3. Вставку элементов в массив оформить в виде подпрограммы. Поиск места вставки, например, первого положительного элемента или максимального элемента, в некоторых задачах также оформить в виде подпрограммы. Заменить последний из нулевых элементов в массиве на три подряд идущих нулевых элемента. Если такая замена невозможна, выдать об этом сообщение.

Задача 4. Проверить упорядочены ли элементы по возрастанию.


Вот что получилось у меня! Только вторую задачу так и не сделала((
А вот с третьей программой ошибка, и я не могу ее найти(((

program kurs_salyakhov_rafail;
uses crt;
const n=10;
type Vector=array [1..n] of integer;
var mas:Vector;
quit: boolean; {выход}
menu: char; {выбор пункта меню}

{---------------------вывод массива на экран-------------------------------}
procedure vivod(var A:Vector);
var i:integer;
begin
writeln('Дан одномерный массив из ',n,' элементов :');
for i:=1 to n do
write(A[i]:5); writeln;
end;

{--------------------ввод массива с клавиатуры-------------------}
procedure vvod_ruchnoi(var A:Vector);
var i:integer;
begin
writeln('Введите элементы вектора ');
for i := 1 to n do
begin
write('A[', i, ']=');
read(a[i]);
end;
writeln;
vivod(a);
end;

{---------------создание случайного массива----------------------}
procedure vvod_random(var A:Vector);
var i:integer;
begin
for i := 1 to n do
A[i] := Random(21)-10;
vivod(a);
end;


{---------функция "нажмите Enter для продолжения"----------------}
procedure vkonce;
begin
writeln;
writeln('Нажмите Enter для продолжения'); readln;
end;

{---------------------Задача № 1----------------------------------}
{ Найти среднеарифметическое отрицательных элементов массива,
предшествующих первому положительному элементу. }
procedure zadacha1(var A:Vector);
var i, iPP, k: integer;
sum: real;
avr: real;
begin
vivod(a);
i := 1;
while (i <= n) and (A[i] < 0) do
i := i + 1;
iPP := i;
sum := 0;
k := 0;
for i := 1 to iPP do
begin
if A[i] < 0 then begin
sum := sum + A[i];
k := k + 1
end;
end;
writeln;
if k <> 0 then begin
avr:= sum/k;
writeln('Среднеарифметическое отриц. элементов перед первым полож. элементом = ', avr:5:3); writeln;
end
else
writeln('Среднеарифметическое значение не возможно найти, так как отриц. элементов перед первым полож. элементом нет');
writeln;
end;

{---------------------Задача № 2----------------------------------}
{ Удалить из массива элемент, расположенный после первого элемента с максимальным значением,
и элемент, расположенный после первого элемента с минимальным значением. }



{---------------------Задача № 3----------------------------------}
{ Заменить последний из нулевых элементов в массиве на 3 подряд идущих нулевых элемента. }

{добавление 3х нулевых элементов}
procedure plus_3(var A:Vector; mecto:integer;nul:integer);
var i,j,k:integer;

begin
vivod(a);
k:=n;
j:=n+2;
for i:=k downto mecto do
begin
a[j]:=a[i];
end;
for i:=mecto to mecto+2 do
begin
nul:=0;
a[i]:=nul;
end;
vivod(a);
writeln;
end;

{поиск последнего нулевого элемента}
function posled_nul(var A:Vector):integer;
var i:integer;
begin
for i:=n downto 1 do
if a[i]= 0 then
begin
posled_nul:=i;
break;
end
else posled_nul:=0;
end;

{основа задачи №3}
procedure zadacha3(var A:Vector);
var i,j,nul:integer;
begin
i:=0;
i:=posled_nul(a);
if(i=0) then writeln('Невозможно выполнить действие, так как нет нулей!!!')
else
begin
plus_3(a,j,nul);
end;
end;

{---------------------Задача № 4----------------------------------}
{ Проверить упорядочены ли элементы по возрастанию. }

procedure zadacha4(var A:Vector);
var i: integer; p: boolean;
begin
vivod(a);
p:=true;
for i:=1 to n-1 do
if (a[i]>a[i+1]) then p:=false;
if p then writeln ('Элементы упорядочены по возрастанию')
else writeln ('Элементы не упорядочены по возрастанию');
end;

{-------------------Главная программа----------------------------}

begin
quit:=false;
repeat {меню программы}
WriteLn;
clrscr;
WriteLn('Выберите способ ввода массива:');
WriteLn('1 - Ввод массива с клавиатуры');
WriteLn('2 - Создание случайного массива');
WriteLn;
WriteLn('Выберите задачу:');
WriteLn('3 - Задача 1. Обработка элементов вектора');
WriteLn('4 - Задача 2. Удаление элементов вектора');
WriteLn('5 - Задача 3. Вставка в вектор новых элементов');
WriteLn('6 - Задача 4. Проверка состояния вектора');
WriteLn;
WriteLn('0 - Выход из программы');
WriteLn;
Write('Выберите(0-6): ');readln(menu);
WriteLn;
case menu of
'1':
begin
vvod_ruchnoi(mas);
vkonce;
end;

'2':
begin
vvod_random(mas);
vkonce;
end;

'3':
begin
zadacha1(mas);
vkonce;
end;

'5':
begin
zadacha3(mas);
vkonce;
end;

'6':
begin
zadacha4(mas);
vkonce;
end;

'0': quit:= true;

end;
until quit=true; {выход из меню и программы}
end.


Помогите плиз! Я уже устала от этих задач, они мне снятся уже(
К. Иванова вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070