Технический форум
Вернуться   Технический форум > Программирование > Форум программистов


Ответ
 
Опции темы Опции просмотра
Старый 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.


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

Старый 17.05.2013, 09:53
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

На форуме и ранее задавали такие вопросы

Помогите найти ошибку
Помогите найти ошибку в схеме
Помогите найти ошибку в программе
Помогите найти ошибку
Помогите найти ошибку
Помогите найти ошибку

Старый 17.05.2013, 15:55   #2 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,229
Сказал(а) спасибо: 286
Поблагодарили 505 раз(а) в 163 сообщениях
Репутация: 91625
По умолчанию

Цитата:
Сообщение от К. Иванова Посмотреть сообщение
Вот что получилось у меня!
Ну а вот что получилось у меня. Несколько комментариев:
1. В Вашей программе, с моей точки зрения, много всякого лишнего. Можно проще и короче.
2. В то же время кое-чего не хватает. В частности, запуска генератора случайных чисел (Randomize;).
3. Всякие дебильные преподские указули типа как и что мне описать в виде чего (процедур, функций) я оставляю без внимания, ибо считаю, что программист должен сам такие вещи решать. Извините.
4. Английский язык используется не для выпендрёжа, а просто мне напряжно работать с кириллицей. Поправьте, если надо.
Код:
uses CRT;
const
 n=10;
type
 Vector=array [1..n] of integer;
var
 mas:Vector;
 m,q:Byte;


procedure vivod(var A:Vector);
var i:integer;
begin
 writeln('Initial array:');
 for i:=1 to n do
  write(A[i]:5);
 writeln;
end;

procedure vvod_ruchnoi(var A:Vector);
var i:integer;
begin
 for i:=1 to n do
 begin
  write('A[', i, ']= ');
  readln(a[i]);
 end;
 writeln;
 vivod(A);
end;

procedure vvod_random(var A:Vector);
var i:integer;
begin
 Randomize;
 for i:=1 to n do
  A[i]:=-10+Random(21);
 vivod(A);
end;


procedure zadacha1(var A:Vector);
var
 i,k: integer;
 sum: real;
begin
 vivod(A);
 i:=0;
 k:=0;
 Sum:=0;
 repeat
  i:=i+1;
  if A[i]<0 then
   begin
    Sum:=Sum+A[i];
    k:=k+1;
   end;
 until (A[i]>0) or (i=n);
 if k>0 then
  Writeln('Arithmetic mean is ',Sum/k:0:3)
 else
  Writeln('No such elements!');
end;

procedure zadacha2(var A:Vector);
var
 B,C: Vector;
 i,Imin,Imax,Min,Max,n1,n2: integer;
begin
 vivod(A);
 B:=A;
 Max:=B[1];
 for i:=2 to n do
  if B[i]>Max then Max:=B[i];
 i:=0;
 repeat
  i:=i+1;
 until B[i]=Max;
 Imax:=i;
 If Imax=n then
  begin
   Writeln('First maximal element is the last one!');
   n1:=n;
  end
 else
 If Imax=n-1 then
  n1:=n-1
 else
  begin
   for i:=Imax+2 to n do B[i-1]:=B[i];
   n1:=n-1;
  end;
 C:=B;
 Min:=C[1];
 for i:=2 to n1 do
  if C[i]<Min then Min:=C[i];
 i:=0;
 repeat
  i:=i+1;
 until C[i]=Min;
 Imin:=i;
 If Imin=n1 then
  begin
   Writeln('First minimal element is the last one!');
   n2:=n1;
  end
 else
 If Imin=n1-1 then
  n2:=n1-1
 else
  begin
   for i:=Imin+2 to n1 do C[i-1]:=C[i];
   n2:=n1-1;
  end;
 Writeln('New array:');
 For i:=1 to n2 do write(C[i]:5);
 writeln;
end;

procedure zadacha3(var A:Vector);
var
 i,Izero:integer;
 B:Array[1..n+2] of integer;
begin
 vivod(A);
 for i:=1 to n do B[i]:=A[i];
 i:=n+1;
 repeat
  i:=i-1;
 until (A[i]=0) or (i=1);
 if (i=1) and (A[i]<>0) then
  writeln('No zero elements!')
 else
  begin
   Izero:=i;
   if Izero=n then
    begin
     B[n+1]:=0;
     B[n+2]:=0;
    end
   else
    begin
     for i:=n downto Izero+1 do B[i+2]:=A[i];
     B[Izero+1]:=0;
     B[Izero+2]:=0;
    end;
   Writeln('New array:');
   for i:=1 to n+2 do write(B[i]:5);
  end;
 writeln;
end;

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;
 Writeln(p);
end;

Begin
 ClrScr;
 Repeat
  WriteLn;
  repeat
   WriteLn('Elements entering metod:');
   WriteLn('   1 - console');
   WriteLn('   2 - random');
   WriteLn('   3 - exit');
   Readln(m);
  until (m>0) and (m<4);
  if m<3 then
   begin
    if m=1 then vvod_ruchnoi(mas);
    if m=2 then vvod_random(mas);
    repeat
     Writeln;
     WriteLn('Chooze the task:');
     WriteLn('  1 - Arithmetic mean');
     WriteLn('  2 - Excluding of elements');
     WriteLn('  3 - Inserting zeroes');
     WriteLn('  4 - Test of ordering');
     WriteLn('  5 - Exit');
     Readln(q);
     if (q=0) or (q>5) then q:=5;
     Case q of
       1: zadacha1(mas);
       2: zadacha2(mas);
       3: zadacha3(mas);
       4: zadacha4(mas);
     End;
    until q=5;
   end;
 Until m=3;
End.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

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

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 02:13.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.