Задача 26

program Project1;

{Написать программу, проверяющую своевременность закрытия скобок в строке символов.}

uses

SysUtils;

const

P1 = '(';

P2 = ')';

Q1 = '[';

Q2 = ']';

Z1 = '{';

Z2 = '}';

var

StrSrc : String;

i, PCnt, QCnt, ZCnt : Integer;

begin

Writeln('Vvedite stroku:');

Readln(StrSrc);

PCnt := 0;

QCnt := 0;

ZCnt := 0;

for i := 1 to Length(StrSRc) do begin

case StrSrc[i] of

P1 : Inc(PCnt);

P2 : Dec(PCnt);

Q1 : Inc(QCnt);

Q2 : Dec(QCnt);

Z1 : Inc(ZCnt);

Z2 : Dec(ZCnt);

end;

end;

if PCnt = 0 then Writeln('Krugly`e sqobqi sbalansirovany`.')

else Writeln('Krugly`e sqobqi ne sbalansirovany`.');

if QCnt = 0 then Writeln('Kvadratny`e sqobqi sbalansirovany`.')

else Writeln('Kvadratny`e sqobqi ne sbalansirovany`.');

if ZCnt = 0 then Writeln('Figurny`e sqobqi sbalansirovany`.')

else Writeln('Figurny`e sqobqi ne sbalansirovany`.');

Readln;

end.

ЗАДАЧА 27

ЗАДАЧА 28

program programs;

{Описать рекурсивную числовую функцию, подсчитывающую сумму элементов дерева.}

uses crt;

type seria = file of integer;

var s: seria;

name: string;

function neg(var s: seria): integer;

var ch,k: integer;

begin

k:=0;

repeat

read(s,ch);

inc(k);

until ch = 0;

neg:=k;

end;

begin clrscr;

write('Vvedite imea faila dlea chtenia: '); readln(name);

assign(s,name);

writeln('Kolichestvo otritsatelinyh chisel v faile ',name, ' = ',neg(s));

readkey; end.

ЗАДАЧА 29

ЗАДАЧА 30

program programs;

{Описать логическую функцию, проверяющую, есть ли в непустом бинарном дереве хотя бы два одинаковых элемента.}

var

i,j,k,n:integer;

l:array [1..1000] of integer;

flag:boolean;

begin

randomize;

readln(n);

for i:=1 to n do l[i]:=random(68)-34;

for i:=1 to n do begin

for j:=i+1 to n do

if l[i]=l[j] then begin writeln('есть'); break; end;

end;

end.

ЗАДАЧА 31

program Project1;

{Задана последовательность слов.

Определить частоту вхождения каждого из слов в последовательность.}

{$APPTYPE CONSOLE}

uses

SysUtils;

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

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,b:array[1..100] of string;

i,n,q:integer;

t,x,z:string;

begin

write('n=');

readln(n);

for i:=1 to n do

begin

writeln(i,'=');

readln(a[i]);

end;

b[1]:=a[1];

x:=a[1]+'-';

q:=1;

t:=a[1]+' ';

for i:=2 to n do

begin

t:=t+a[i]+' ';

if pos(a[i],x)=0 then

begin

x:=x+a[i]+'-';

inc(q);

b[q]:=a[i];

end;

end;

writeln('string=',t);

for i:=1 to q do

writeln(b[i],'=',NV(b[i],t)/n*100:00:00,'%);

readln;

{ TODO -oUser -cConsole Main : Insert code here }

end.

ЗАДАЧА 32

program Project1;

{Подсчитать k - количество цифр в

десятичной записи целого неотрицательного числа n.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n:integer;

begin

{ TODO -oUser -cConsole Main : Insert code here }

readln(n);

writeln(length(inttostr(n)));

readln;

end.

ЗАДАЧА 33

program Project1;

{Переменной t присвоить значение 1 или 0 в

зависимости от того, является ли натуральное число k степенью 3.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var t,k:integer;

begin

{ TODO -oUser -cConsole Main : Insert code here }

readln(k);

if (k mod 3)=0 then t:=1

else t:=0;

writeln('t=',t);

readln;

end.

ЗАДАЧА 34

program Project1;

{Дано n вещественных чисел.

Вычислить разность между максимальным и минимальным из них.}

{$APPTYPE CONSOLE}

uses

SysUtils;

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

min,max,n,i:integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

max:=-1000;

min:=1000;

for i:=1 to n do

begin

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

if a[i]<min then min:=a[i];

end;

writeln(max,'-',min,'=',max-min);

readln;

{ TODO -oUser -cConsole Main : Insert code here }

end.

ЗАДАЧА 35

program Project1;

{Дана непустая последовательность различных натуральных чисел,

за которой следует 0. Определить порядковый номер наименьшего из них.}

{$APPTYPE CONSOLE}

uses

SysUtils;

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

min,x,i,n:integer;

begin

readln(n);

for i:=1 to n do

readln(a[i]);

min:=-1000;

for i:=1 to n-1 do

if a[i]<min then

begin

min:=a[i];

x:=i;

end;

writeln('min i=',x);

readln;

{ TODO -oUser -cConsole Main : Insert code here }

end.

ЗАДАЧА 36

program Project1;

{Даны целое n>0 и последовательность из n вещественных чисел, среди

которых есть хотя бы одно отрицательное число. Найти величину наибольшего

среди отрицательных чисел этой последовательности.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,min:integer;

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

begin

readln(n);

for i:=1 to n do

readln(a[i]);

min:=-1000;

for i:=1 to n do

if (a[i]>min) and (a[i]<>abs(a[i])) then min:=a[i];

writeln(min);

readln;

end.

ЗАДАЧА 37

program Project1;

{Дано n вещественных чисел. Определить,

образуют ли они возрастающую последовательность.}

{$APPTYPE CONSOLE}

uses

SysUtils;

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('obraz')

else

writeln('ne obraz');

readln;

end.

ЗАДАЧА 38

program Project1;

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

Определить, со скольких отрицательных чисел она начинается.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,x: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[i]>0 then

begin

x:=i-1;

break;

end;

writeln(x);

readln;

end.

ЗАДАЧА 39

program Project1;

{Определить k - количество трехзначных натуральных чисел,

сумма цифр которых равна n (1<=n<=27). Операции деления.

(/, div и mod) не использовать.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,x,z:integer;

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

begin

x:=0;

for i:=100 to 999 do

begin z:=strtoint(copy(inttostr(i),1,1))+strtoint(copy(inttostr(i),2,1))+strtoint(copy(inttostr(i),3,1));

if (1<=z) and (z<=27) then inc(x);

end;

writeln(x);

readln;

end.

ЗАДАЧА 40

program Project1;

{Вывести на экран в возрастающем порядке все трехзначные числа,

в десятичной записи которых нет одинаковых цифр

(операции деления не использовать).}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,x:integer;

begin

for i:=100 to 999 do

if strtoint(copy(inttostr(i),2,1))<>strtoint(copy(inttostr(i),3,1)) then

writeln(i);

readln;

end.

ЗАДАЧА 41

program Project1;

{Переменной t присвоить значение 1 или 0 в зависимости от того,

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

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,j,x,x1,x2,x3:integer;

t:integer;

begin

readln(n);

t:=0;

for i:=1 to n do

for j:=1 to n do

for x:=1 to n do

if ((i*i)+(j*j)+(x*x))=n then

begin

t:=1;

x1:=i;

x2:=j;

x3:=x;

break;

end;

writeln('t=',t);

writeln(x1,' ',x2,' ',x3);

readln;

end.

ЗАДАЧА 42

program Project1;

{Дано натуральное число n. Выяснить, входит ли цифра 3 в запись числа n2}

uses

SysUtils;

var n,i:integer;

f:boolean;

begin

f:=false;

readln(n);

n:=n*n;

for i:=1 to length(inttostr(n)) do

if inttostr(n)[i]='3' then

begin

f:=true;

break;

end;

if f then writeln('est')

else writeln('net');

readln;

end.

ЗАДАЧА 43

program Project1;

{Дано натуральное число n. Найти сумму его цифр.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,x:integer;

t:string;

begin

readln(n);

t:=inttostr(n);

for i:=1 to length(t) do

x:=x+strtoint(t[i]);

writeln(x);

readln;

end.

ЗАДАЧА 44

program Project1;

{Дано целое n>0, за которым следует n вещественных чисел. Определить, сколько среди них отрицательных.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i,x:integer;

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

begin

readln(n);

for i:=1 to n do

readln(a[i]);

x:=0;

for i:=1 to n do

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

writeln(x);

readln;

end.

ЗАДАЧА 45

program Project1;

{Дано натуральное число n. Переставить местами первую и последнюю цифры числа n.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n:integer;

begin

readln(n);

writeln(inttostr(n)[length(inttostr(n))]+copy(inttostr(n),2,length(inttostr(n))-2)+inttostr(n)[1]);

readln;

end.

ЗАДАЧА 46

program Project1;

{Дано натуральное число n. Заменять порядок следования цифр числа n на обратный.}

{$APPTYPE CONSOLE}

uses

SysUtils;

var n,i:integer;

t:string;

begin

readln(n);

t:='';

for i:=length(inttostr(n)) downto 1 do

t:=t+inttostr(n)[i];

writeln(t);

readln;

end.

ЗАДАЧА 47

program Project1;

{В одномерном массиве, состоящем из n целых элементов, вычислить произведение элементов массива,

расположенных между максимальным и минимальным элементами.}

var n:integer;

i:integer;

min,max:integer;

Imin,Imax:integer;

x,y:integer;

p:integer;

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

begin

readln(n);

for i:=1 to n do

readln(a[i]);

max:=-1000;

min:=1000;

for i:=1 to n do

begin

if a[i]>max then

begin

max:=a[i];

Imax:=i;

end;

if a[i]<min then

begin

min:=a[i];

Imin:=i;

end;

end;

if Imax>Imin then

begin

x:=Imin;

y:=Imax;

end

else

begin

x:=Imax;

y:=Imin;

end;

p:=1;

for i:=x+1 to y-1 do

p:=p*a[i];

writeln('p=',p);

readln;

end.