Задача 70

program Project1;

{Если длина введенной строки >15, удалить все буквы - a…z.}

{$APPTYPE CONSOLE}

uses

SysUtils;

function DCOL(s,s1:string):string;

var i,j:integer;

begin

for i:=length(s) downto 1 do

if copy(s,i,length(s1))=s1 then

delete(s,i,length(s1));

result:=s;

end;

var t,n:string;

i:integer;

begin

readln(n);

if (length(n)>15) then

begin

n:=DCOL(n,'a');

n:=DCOL(n,'b');

n:=DCOL(n,'c');

n:=DCOL(n,'d');

n:=DCOL(n,'e');

n:=DCOL(n,'f');

n:=DCOL(n,'g');

n:=DCOL(n,'h');

n:=DCOL(n,'i');

n:=DCOL(n,'j');

n:=DCOL(n,'k');

n:=DCOL(n,'l');

n:=DCOL(n,'m');

n:=DCOL(n,'n');

n:=DCOL(n,'o');

n:=DCOL(n,'p');

n:=DCOL(n,'q');

n:=DCOL(n,'r');

n:=DCOL(n,'s');

n:=DCOL(n,'t');

n:=DCOL(n,'u');

n:=DCOL(n,'v');

n:=DCOL(n,'w');

n:=DCOL(n,'x');

n:=DCOL(n,'y');

n:=DCOL(n,'z');

end;

writeln(n);

readln;

end.

ЗАДАЧА 71

program Project1;

{Если длина введенной строки >15, удалить все буквы - a…z.}

{$APPTYPE CONSOLE}

uses

SysUtils;

function DCOL(s,s1:string):string;

var i,j:integer;

begin

for i:=length(s) downto 1 do

if copy(s,i,length(s1))=s1 then

delete(s,i,length(s1));

result:=s;

end;

var t,n:string;

i:integer;

begin

readln(n);

for i:=1 to length(n) do

if (i mod 2)=1 then t:=n[i]

else

begin

n[i-1]:=n[i];

n[i]:=t[1];

end;

writeln(n);

readln;

end.

ЗАДАЧА 72

program Project1;

{Если длина введенной строки >6, выделить подстроку в скобках.}

var n:string;

begin

readln(n);

if (length(n)>6) then

writeln('{'+copy(n,1,6)+'}'+copy(n,6,length(n)))

else

writeln(n);

readln;

end.

ЗАДАЧА 73

program Project1;

{Ввести строку из цифр, удалить из нее цифры, кратные 3, и записать их в другую строку.}

uses

SysUtils;

var i:integer;

n,t,x:string;

begin

readln(n);

t:='';

x:='';

for i:=1 to length(n) do

if (n[i]<>'3') and (n[i]<>'6') and (n[i]<>'9') then

t:=t+n[i]

else

x:=x+n[i];

writeln(t);

writeln(x);

readln;

end.

ЗАДАЧА 74

program Project1;

{Из символов введенной строки сформировать две строки - из цифр и букв.}

function NV(substr, str: string): integer;

// Количество вхождений строки substr в строку str

var

cnt, p: integer;

begin

cnt := 0;

while str <> '' do

begin

p:=Pos(substr, str);

if p > 0 then inc(cnt)

else p := 1;

Delete(str, 1, (p + Length(substr) - 1));

end;

Result:=cnt;

end;

var

a:array[1..9] of integer;

i,x:integer;

n,t:string;

begin

readln(n);

x:=0;

if length(n)>20 then

begin

a[1]:=NV('one',n);

a[2]:=NV('two',n);

a[3]:=NV('three',n);

a[4]:=NV('four',n);

a[5]:=NV('five',n);

a[6]:=NV('six',n);

a[7]:=NV('seven',n);

a[8]:=NV('eight',n);

a[9]:=NV('nine',n);

for i:=1 to 9 do

x:=x+(i*a[i]);

end;

writeln(x);

readln;

end.

ЗАДАЧА 75

program Project1;

{Из символов введенной строки сформировать две строки - из цифр и букв.}

var

s,s1,s2:string;

i:integer;

begin

readln(s);

s1:='';

s2:='';

for i:=1 to length(s) do

if (s[i]='0') or (s[i]='1') or (s[i]='2') or (s[i]='3') or (s[i]='4') or (s[i]='5') or (s[i]='6') or (s[i]='7') or (s[i]='8') or (s[i]='9') then s1:=s1+s[i]

else s2:=s2+s[i];

writeln(s);

writeln(s1);

writeln(s2);

readln;

end.

ЗАДАЧА 76

program Project1;

{Дана последовательность х1, х2,…,хn и число у. Подсчитать количество элементов последовательности, которые меньше у.}

var

n:integer;

i:integer;

a:array[1..100] of integer;

y:integer;

x:integer;

begin

readln(n);

readln(y);

for i:=1 to n do

readln(a[i]);

x:=0;

for i:=1 to n do

if a[i]<y then inc(x);

writeln(x);

readln;

end.

ЗАДАЧА 77

program Project1;

{Проверить является ли данная числовая последовательность а1, a2,..., an убывающей;}

var n,i:integer;

f:boolean;

a:array[1..100] of integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

f:=true;

for i:=2 to n do

if a[i-1]<a[i] then f:=false;

if f then

writeln('yavl')

else

writeln('ne yavl');

readln;

end.

ЗАДАЧА 78

program Project1;

{Проверить является ли данная числовая последовательность а1, a2,..., an невозрастающей.}

var n,i:integer;

f:boolean;

a:array[1..100] of integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

f:=true;

for i:=2 to n do

if a[i-1]<a[i] then f:=false;

if f then

writeln('yavl')

else

writeln('ne yavl');

readln;

end.

ЗАДАЧА 79

program Project1;

{Проверить является ли данная числовая последовательность а1, a2,..., an неубывающей.}

var n,i:integer;

f:boolean;

a:array[1..100] of integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

f:=true;

for i:=2 to n do

if a[i-1]>a[i] then f:=false;

if f then

writeln('yavl')

else

writeln('ne yavl');

readln;

end.

ЗАДАЧА 80

program Project1;

{Проверить является ли данная числовая последовательность а1, a2,..., an постоянной (все члены равны между собой).}

var n,i:integer;

a:array[1..100] of integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

for i:=2 to n do

if a[1]<>a[i] then

begin

writeln('ne yavl');

break;

end

else

if i=n then

writeln('yavl');

readln;

end.

ЗАДАЧА 81

program Project1;

{Дана последовательность целых чисел a1, a2,...,an. Найти модуль наибольшего по модулю элемента последовательности.}

var n,i,max:integer;

a:array[1..100] of integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

max:=-1000;

for i:=1 to n do

if abs(a[i])>max then max:=abs(a[i]);

writeln(max);

readln;

end.

ЗАДАЧА 82

program Project1;

{Дана последовательность целых чисел a1, a2,...,an. Найти модуль наибольшего элемента последовательности.}

var n,i,max:integer;

a:array[1..100] of integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

max:=-1000;

for i:=1 to n do

if a[i]>max then max:=a[i];

writeln(abs(max));

readln;

end.

ЗАДАЧА 83

program pr83;

{83. Дана последовательность целых чисел a1, a2,...,an.

Найти модуль наименьшего по модулю элемента.}

uses

crt;

var

i,n:byte;

min:integer;

a: array [1..100] of integer;

begin

clrscr;

Write('Vvedite kolichestvo chlenov posledovatelnosti: ');

Read(n);

Writeln('Vvedite posledovatelnost:');

for i:=1 to n do

begin

Write(i,'-i element: ');

Readln(a[i]);

end;

min:=100000;

for i:=1 to n do

if abs(a[i])<min then

min:=abs(a[i]);

Writeln('Ishodnye dannye: ');

for i:=1 to n do

Writeln(i,'-i element: ',a[i]);

Writeln('min>0= ',min);

Readln;

end.