Перейти к содержанию

Помогите решить задачу паскаль


Рекомендуемые сообщения

1)Выясните, имеются ли в заданном целочисленном векторе A(N) три подряд идущих элемента одного знака.

2)В заданном массиве A(N), все элементы которого попарно различны, найдите:

а) наибольший элемент из отрицательных;

б) наименьший элемент из положительных;

в) в) второй по величине элемент.

:help:

Ссылка на комментарий

1) цикл с первого до предпред последнего. в теле цикла если произведение текущего элемента на следующий положительно и произведение следующего на следующего следующего :) положительно тогда имеем 3 подряд идущих элемента одного знака.

модернизация (цикл с предусловием---> чтобы не делать лишние итерации)

Ссылка на комментарий
Я в программе не шарю нисколько)

Дайте лучше код

тебе выкладывают алгоритм и куски кода) дальше ты уж сам :)

P.S. знаешь как прикалываются программисты, когда им пишут напишите мне готовую программу :)

Они её специально с ошибками пишут, то точку запятую пропустят, то в переменной одну букву изменят, то + на - переправят. Ибо нефиг :)

Ссылка на комментарий

1) примерно так:

program Project1;
const n=10;
var
a: array [1..n] of integer;
i,z,num: integer;

function znak(x:integer):INTEGER;
begin
if x>0 then znak:=1
else if x<0 then znak:=-1
else znak:=0;
end;

begin

for i:=1 to n do
readln(a[i]);
i:=2;
num:=1;
z:=znak(a[1]);
while i<=n do
begin
if znak(a[i])=0 then begin i:=i+1;continue;end;
if znak(a[i])=z then
begin
inc(num);
if num=3 then
begin Writeln('yes'); readln; exit;end;
end
else begin num:=1;z:=znak(a[i]);end;
i:=i+1;
end;
Writeln('no'); readln;
end.

Ссылка на комментарий

Ну вроде вот так:

uses crt;

const n=20;

var A:array[1..n] of integer;
i:word;
M,NiO,NiP,VpV:integer;

BEGIN
{-------------------------------------------------}
clrscr;
randomize;
for i:= 1 to n do
begin A[i]:=random(100)-50; write(A[i],' '); end;
writeln;
readkey;
{-------------------------------------------------}
M:=A[1]; NiP:=32767; NiO:=-32768; VpV:=-32768;
for i:= 1 to n do
begin
if (i<>1) then
if (A[i]>M) then begin VpV:=M; M:=A[i]; end
else
if ((A[i]>VpV)and(A[i]<>M)) then VpV:=A[i];
if (A[i]>0) then if (A[i] if (A[i]<0) then if (A[i]>NiO) then NiO:=A[i];
end;
writeln('Vtoroy po velichine:',VpV);
writeln('Naimenshiy iz polojitelnih:',NiP);
write('Naibolshiy iz otricatelnih:',NiO);
readkey;
END.

Конечно рандомный массив для примера.

И такое присвоение:

...
NiP:=32767; NiO:=-32768; VpV:=-32768;
...

Макс и мин для integer мне не нравится, но в один проход по-моему ничего лучше не придумать))

Ссылка на комментарий

2)В заданном массиве A(N), все элементы которого попарно различны, найдите:

а) наибольший элемент из отрицательных;

б) наименьший элемент из положительных;

в) второй по величине элемент.

   Максимальную производительность, учитывая всегда произвольный набор элементов [цифЕр] в массиве, даст квиксорт. Любое решение за один проход - заведомо неверно или же будет настолько заполнено иф-ами, что скорости не прибавит.

  if (i<>1)   then

    if (A>M) then begin VpV:=M; M:=A; end

    else

      if ((A>VpV)and(A<>M)) then VpV:=A;

Первое условие if (i<>1) излишнее - в следующем условии оно дублируется if (A>M). К тому же не учтено, что первое число - максимальное.

sja := 0;
sjb := -1; //здесь -1 дабы отойти от холиваров про 0 положительное или не положительное число. поэтому будем считать 0 - положительным
sjc := a[1];
m := a[1];
d := 65535;
for i := 1 to n do begin
if a[i] < 0 then
if sja = 0 then sja := a[i]
else if a[i] > sja then sja := a[i];
if a[i] >= 0 then
if sjb = -1 then sjb := a[i]
else if a[i] < sjb then sjb := a[i];
if a[i] > m then begin
sjc := m;
m := a[i];
d := 0;
end
else if (d <> 0) and (a[i] < m) then
if d < m - a[i] then d := m - a[i]
end;
if sja = 0 then writeln ('Отрицательных эл-тов нет в массиве')
else writeln ('a - ', sja);
if sjb = -1 then writeln ('Положительных эл-тов нет в массиве')
else writeln ('b - ', sjb);
if m = a[1] then sjc := m - d;
if n = 1 then wirteln ('В массиве всего 1 элемент')
else writeln ('c - ', sjc);

вот такой вот изврат

Ссылка на комментарий
Максимальную производительность, учитывая всегда произвольный набор элементов [цифЕр] в массиве, даст квиксорт. Любое решение за один проход - заведомо неверно или же будет настолько заполнено иф-ами, что скорости не прибавит.

Ёб... а я писал что-то про производительность?!

Ну и конечно я проверки не делал, соответственно всякие вытекающие пакости выпадают, мой код для правильного массива)))

В принципе можно и прикрутить проверки, но это уже должен делать сам просящий...

Первое условие if (i<>1) излишнее - в следующем условии оно дублируется if (A>M).

Это да... пропустил, просто добавил условие A<>M, а про первый иф забыл))

К тому же не учтено, что первое число - максимальное.

А вот как раз таки и учтено!

внимательней код просмотри! если не веришь... копируешь в блокнот, сохраняешь как *.раs, открываешь ТП, компилишь и радуешься))

uses crt;

const n=20;

var A:array[1..n] of integer;
i:word;
M,NiO,NiP,VpV:integer;

BEGIN
{-------------------------------------------------}
clrscr;
randomize;
for i:= 1 to n do
begin A[i]:=random(100)-50; write(A[i],' '); end;
writeln;
readkey;
{-------------------------------------------------}
M:=A[1]; NiP:=32767; NiO:=-32768; VpV:=-32768;
for i:= 1 to n do
begin
if (A[i]>M) then begin VpV:=M; M:=A[i]; end
else
if ((A[i]>VpV)and(A[i]<>M)) then VpV:=A[i];
if (A[i]>0) then if (A[i] if (A[i]<0) then if (A[i]>NiO) then NiO:=A[i];
end;
writeln('Vtoroy po velichine:',VpV);
writeln('Naimenshiy iz polojitelnih:',NiP);
write('Naibolshiy iz otricatelnih:',NiO);
readkey;
END.

Вот тебе так сказать трассировка:: (конечно так для примера)

А=(10,-3,-5,6,3)

1) А[1]=10 M=10 NiP=10 NiO=-32768 VpV=-32768

2) А[2]=-3 M=10 NiP=10 NiO=-3 VpV=-3

3) А[3]=-5 M=10 NiP=10 NiO=-3 VpV=-3

4) А[4]=6 M=10 NiP=6 NiO=-3 VpV=6

5) А[5]=3 M=10 NiP=3 NiO=-3 VpV=6

1_b61b3ece2a9dbf53b2ba20fc38d00064.JPG

Ссылка на комментарий

версия 1.2))

uses crt;

const n=20;

var A:array[1..n] of integer;
i,CP,CO:word;
M,NiO,NiP,VpV:integer;

function Puhdys : boolean;
begin
for i:= 1 to n do
begin
if (A[i]>0) then inc(CP);
if (A[i]<0) then inc(CO);
if (A[i]>M) then M:=A[i];
if (A[i]end;
if ((CP>1)and(CO>1)) then Puhdys:=true else Puhdys:=false;
end;

BEGIN
clrscr;
{-------------------------------------------------}
randomize;
for i:= 1 to n do
begin A[i]:=random(100)-50; write(A[i],' '); end;
writeln;
{-------------------------------------------------}
M:=A[1]; NiO:=A[1]; CP:=0; CO:=0;
if Puhdys then
begin
VpV:=NiO; NiP:=M;
for i:= 1 to n do
begin
if ((A[i]<>M)and(A[i]>VpV)) then VpV:=A[i];
if ((A[i]>0) and(A[i] if ((A[i]<0) and(A[i]>NiO)) then NiO:=A[i];
end;
writeln('Второй по величине:',VpV);
writeln('Наименьший из положительных:',NiP);
write('Наибольший из отрицательных:',NiO);
end
else
write('Массив не подходит!');
readkey;
END.

Ссылка на комментарий
Ёб... а я писал что-то про производительность?!

   =D это было написано к сведению, а не тебе ))) твоего ника там не было и копираста твоего тоже )) так что не бздеть )

   voland, да действительно, максимальное учитывается, но все же лишняя проверка (A<>M) =Р

   К тому же, что за проверка a <> M, к любому моменту кроме переприсваивания М - a не равно M (это видно из условия).

//add

ну ты извращенец =D сейчас примерно глянул чего ты делаешь в процедуре - изврат какой то. докучи для читабельности всегда надо передавать параметр. да и вообще в памяти отложилось, что нехорошо изменять значение переменной, которую не передаешь в функции через var

add//

   Даже мой (кажущийся мне длинным код) не так ужасен как твой =D К тому же алерты у тебя странные =Р Мой код рабочий и короткий, учитывает все что можно вытащить из задачи )) так что зачем было столько мучиться да и еще паскаль запускать =Р я так все написал )))

Ссылка на комментарий
voland, да действительно, максимальное учитывается, но все же лишняя проверка (A<>M) =Р

Ты всезнайка, который пишет такие умные вещи, вот нахер запусти и посмотри что получится без проверки (A<>M), чему будет приравнен VpV, без этого условия.

Сколько раз говорить то!!!

ну ты извращенец =D сейчас примерно глянул чего ты делаешь в процедуре - изврат какой то. докучи для читабельности всегда надо передавать параметр. да и вообще в памяти отложилось, что нехорошо изменять значение переменной, которую не передаешь в функции через var

Ну во-первых, это не процедура а функция, а во-вторых, всё в ней нормально, функция для нахождения мин и макс, проверки массива на удовлетворение условию.

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

 Даже мой (кажущийся мне длинным код) не так ужасен как твой =D К тому же алерты у тебя странные =Р Мой код рабочий и короткий, учитывает все что можно вытащить из задачи )) так что зачем было столько мучиться да и еще паскаль запускать =Р я так все написал )))

По идее мой первый код был и есть рабочий, только без проверок, а вот нахера ты свой написал...

Версия 1.3 final - без тараканов)))

uses crt;

const n=20;

var A:array[1..n] of integer;
i,CP,CO:word;
M,NiO,NiP,VpV:integer;

BEGIN
clrscr;
{-------------------------------------------------}
randomize;
for i:= 1 to n do
begin A[i]:=random(100)-50; write(A[i],' '); end;
writeln;
{-------------------------------------------------}
M:=A[1]; NiO:=A[1]; CP:=0; CO:=0;
for i:= 1 to n do
begin
if (A[i]>0) then inc(CP);
if (A[i]<0) then inc(CO);
if (A[i]>M) then M:=A[i];
if (A[i]end;
if ((CP>1)and(CO>1)) then
begin
VpV:=NiO; NiP:=M;
for i:= 1 to n do
begin
if ((A[i]<>M)and(A[i]>VpV)) then VpV:=A[i];
if ((A[i]>0) and(A[i] if ((A[i]<0) and(A[i]>NiO)) then NiO:=A[i];
end;
writeln('Второй по величине:',VpV);
writeln('Наименьший из положительных:',NiP);
write('Наибольший из отрицательных:',NiO);
end
else
write('Массив не подходит!');
readkey;
END.

Ссылка на комментарий

скопируй, вставь и запусти =Р



const n=20;

var A:array[1..n] of integer;
i:word;
M,NiO,NiP,VpV:integer;

BEGIN
{-------------------------------------------------}
clrscr;
randomize;
for i:= 1 to n do
begin A[i]:=random(100)-50; write(A[i],' '); end;
writeln;
readkey;
{-------------------------------------------------}
M:=A[1]; NiP:=32767; NiO:=-32768; VpV:=-32768;
for i:= 1 to n do
begin
if (i<>1) then
if (A[i]>M) then begin VpV:=M; M:=A[i]; end
else
if (A[i]>VpV) then VpV:=A[i]; //удалил and(A[i]<>M)
if (A[i]>0) then if (A[i] if (A[i]<0) then if (A[i]>NiO) then NiO:=A[i];
end;
writeln('Vtoroy po velichine:',VpV);
writeln('Naimenshiy iz polojitelnih:',NiP);
write('Naibolshiy iz otricatelnih:',NiO);
readkey;
END.
uses crt;

По идее мой первый код был и есть рабочий, только без проверок, а вот нахера ты свой написал...

потому что мой рабочий и правильный (1ый в ветке) во всех случаях. а твои модификации я уже слабо смотрел, т.к. смысла не вижу разбираться в чужом, если с использованием 1 цикла мой верный. с использованием нескольких циклов задача вообще не имеет никакой сложности =)

//add таки посмотрел последний твой код без тараканов:

voland, если в массиве хотя бы одно положительное число или одно отрицательное число, то у тебя CP = 1 или CO = 1, тогда у тебя проверка

if ((CP>1)and(CO>1))

не сработает и вообще скажет, что массив не подходит.

хотя массив a: a[1]=-1, a[2]=1 не подойдет по условиям, хотя

а) наибольший элемент из отрицательных; -1

б) наименьший элемент из положительных; 1

в) второй по величине элемент. -1

да и в целом, даже если массив: а = [-1,2,3,4,5,6] у тебя вылезет ошибка.

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

Ссылка на комментарий
voland, если в массиве хотя бы одно положительное число или одно отрицательное число, то у тебя CP = 1 или CO = 1, тогда у тебя проверка

if ((CP>1)and(CO>1))

не сработает и вообще скажет, что массив не подходит.

А так и должно быть!

да и в целом, даже если массив: а = [-1,2,3,4,5,6] у тебя вылезет ошибка.

Ну да всё правильно, как я понял надо чтобы было как минимум по 2 положительных и отрицательных, смысл тогда находить наименьшие и наибольшие из + и -

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

А смысл вообще это делать? ошибка да ошибка! пох какая, пусть сам соображает что исправить...

После этих наездов на ифы и код, вот скажи вообще нахера пипи на код если ты его даже толком не смотрел, попипи решил?

Только с нескольких заходов дошло зачем вообще нужно условие A<>M, и дошло ли вообще....

Ссылка на комментарий
Ну да всё правильно

хаха:

Задан произвольный массив (n<100), выберите из него максимальное число.


m, i, n: integer;
a: array [1..99] of integer;
begin
write ('n = ');
readln(n);
if n = 1 then writeln('В массиве одно число и оно не может быть максимальным числом в массиве, ведь оно одно')
else
...
end.
var

извини конечно, но чушь пишешь.

Добавлено спустя 1 минуту 24 секунды:

А смысл вообще это делать? ошибка да ошибка! пох какая, пусть сам соображает что исправить

можно вычислить - вычисляй, какой то нельзя - сообщи об этом. а не ломай все на корю. а у тебя какое то гавнокодерство.

Добавлено спустя 2 минуты 28 секунд:

Только с нескольких заходов дошло зачем вообще нужно условие A<>M, и дошло ли вообще....

нет одинаковых чисел в массиве, при одном проходе максимальное число не может повториться в массиве, посему проверять на неравенство с максимальным смысла нет.

Ссылка на комментарий
Них** себе.

Версия 1.3 как я понял правильная?

Добавлено спустя 48 секунд:

Или ничего неверно?

Да, ответ выдаст верный, но там пару условий и проверку надо изменить...

Ссылка на комментарий

Пожалуйста, войдите, чтобы комментировать

Вы сможете оставить комментарий после входа в



Войти
  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...