Задача 20

Program progras;

{Описать процедуру, которая удаляет из списка А за каждым вхождением элемента Е один элемент, если такой есть и он отличен от Е.}

type pt = ^elem;

elem = record

data:string;

next : pt;

end;

procedure addItem(var list: pt; item: string);

begin

if list=nil then begin new(list);

list^.next:=nil;

list^.data:=item;

end else begin

addItem(list^.next,item);

end;

end;

procedure deleteElement(var list: pt; item : string);

var

tmp: pt;

begin

if list<>nil then begin

if list^.next<>nil then begin

if (list^.data=item) and (list^.next^.data<>item) then begin

list^.next^.data:='';

tmp:=list^.next^.next;

dispose(list^.next);

list^.next:=tmp;

end;

deleteElement(list^.next,item);

end;

end;

end;

procedure printList(list: pt);

begin

if list<>nil then begin

WriteLn(list^.data);

printList(list^.next);

end;

end;

procedure freeMemory(var list: pt);

begin

if list<>nil then begin

freeMemory(list^.next);

list^.data:='';

dispose(list);

list:=nil;

end;

end;

var

E: string;

element: string;

spisok: pt;

F:text;

begin

spisok:=nil;

Write('E=');

ReadLn(E);

WriteLn('Vvodite elementi spiska, pustaya stroka - okonchanie vvoda');

repeat

readln(element);

addItem(spisok,element);

until element='';

deleteElement(spisok,E);

WriteLn('');

printList(spisok);

freeMemory(spisok);

readln;

end.

ЗАДАЧА 21

ЗАДАЧА 22

program programs;

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

uses crt;

type

Tlist=^Rlist;

Rlist=record

x:integer;

y:Tlist;

end;

var

a,b,c,d,f,g:Tlist;

z:integer;

begin

clrscr;

{создаем список}

a:=nil;

for z:=1 to 10 do

begin

new(b);

readln(b^.x);

b^.y:=a;

a:=b;

end;

c:=nil;

for z:=1 to 10 do

begin

new(d);

readln(d^.x);

d^.y:=c;

c:=d;

end;

{выводим его}

while b<>nil do

begin

write(b^.x:3);

b:=b^.y;

end;

a:=b;

writeln;

while d<>nil do

begin

write(d^.x:3);

d:=d^.y;

end;

writeln;

c:=d;

repeat

while a^.y<>nil do

begin

while c^.y<>nil do

begin

if a^.x = c^.x then

new(f);

f^.x:=a^.x;

f^.y:=a^.y;

end;

end;

until f=nil;

while f<>nil do

begin

write(f^.x:3);

f:=f^.y;

end;

writeln;

g:=f;

readln;

end.

ЗАДАЧА 23

ЗАДАЧА 24

ЗАДАЧА 25

program Project1;

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

{$APPTYPE CONSOLE}

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.