Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Сборник задач Бабалова.doc
Скачиваний:
95
Добавлен:
04.06.2015
Размер:
1.16 Mб
Скачать

Пример 1.3.

program Number_1_3;

{Дана последовательность целых чисел

произвольной длины. С помощью функции найти

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

С помощью процедуры удалить найденный элемент.

Вывести исходную последовательность, элемент,

найденный в последовательности, и результат преобразования}

type s=array [1..50] of integer;

function Seach(var a:s;n:word;x:integer):word;

Var I:word;

begin

writeln('Работает программа- поиск номера',

' элемента последовательности, равного введенному',

' числу x');

Seach:=0;

for i:=1 to n do

if a[i]= x then

Seach:=i;{находится последний по порядку

следования элементов из равных}

end;

procedure Del_el(var a:s;var n:word;d:word);

Var I:word;

begin

writeln('Работает программа- удаление по номеру',

' элемента последовательности, равного введенному',

' числу x');

for i:=d to n-1 do

a[i]:=a[i+1];

n:=n-1;

end;

var aa:s;

X:integer;

I,m:word;

ch:char;

begin

repeat

Writeln('Введите количество элементов последовательности');

readln(m);

Writeln('Введите элементы последовательности',

' в количестве= ',m);

for i:=1 to m do

readln(aa[i]);

writeln('Исходная последовательность');

for i:=1 to m do

write(aa[i],' ');

writeln;

writeln('Введите искомый элемент');

readln(x);

i:=Seach(aa,m,x);

if i<>0 then

begin

Del_el(aa,m,i);

writeln('Результат преобразования');

for i:=1 to m do

write(aa[i],' ');

writeln;

end

else writeln('Последовательность осталась неизменной');

writeln('Будете еще вводить последовательности? ');

readln(ch);

until ch='n';

end.