|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
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
Регистрация: 08.03.2016
Сообщений: 0
|
На форуме и ранее задавали такие вопросы Помогите найти ошибку Помогите найти ошибку в схеме Помогите найти ошибку в программе Помогите найти ошибку Помогите найти ошибку Помогите найти ошибку |
17.05.2013, 15:55 | #2 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ну а вот что получилось у меня. Несколько комментариев:
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. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|