Задача 17

Program progras;

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

type char='a'..'z';

list=^node;

node= record

info :char;

next : list

end;

var s,l : list;

x : char;

n,i : integer;

function sort(l : list) : boolean;

var p,q : list; {ссылка на пару соседних звеньев}

ok : boolean;

begin

ok:=true; p:=L;

{nil или ссылка на 1-е звено} if p<>nil then begin q:=p^.next;

{nil или ссылка на 2-е звено} while (q<>nil) and ok do

begin

ok:=p^.info<=q^.info;

p:=q; q:=q^.next {переход к след. паре}

end

end;

sort:=ok

end;

procedure out_spisok(l:list);

begin

while l<> nil do

begin s:=l^.next; write(l^.info,' '); l:=s; end;

writeln;

end;

begin

{формируем список}

s:=nil;

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

readln(n);

for i:=1 to n do

begin

new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;

{выводим список на экран}

writeln('Введенный список');

out_spisok(l);

if sort(l) then writeln('Список отсортирован по алфавиту')

else writeln('Список не отсортирован по алфавиту');

{освобождаем динамическую память}

while l<> nil do

begin s:=l^.next; dispose(l); l:=s; end;

end.

ЗАДАЧА 18

ЗАДАЧА 19

Program progras;

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

type te=char;

slovo= packed array [1..50] of te; {по условию}

link = ^kom; {начало создания списка}

kom = record

ini : slovo;

next : link;

end; {конец создания списка}

procedure add(var n : link; x:slovo; num:integer);

{данная процедура добавляет в список "n" элемент "x" на порядковое место "num" }

var

neo, ind : link;

i : integer;

begin

new(neo);

neo^.ini:=x;

if n=nil then begin

n:= neo;

neo^.next:=nil;

end

else if num=1 then begin

neo^.next:=n;

n:= neo;

end

else begin

i:=0;

ind:= n;

while (i<>num-2) and (ind^.next<>nil) do begin

i:= i+1;

ind:= ind^.next;

end;

neo^.next:=ind^.next;

ind^.next:= neo;

end;

end; { КОНЕЦ процедуры add }

function veiwLkolvo(n : link):integer; {функция определяющая КОЛ-ВО, требовающееся в задании}

var

ind : link; slotek1,slotek2:slovo;

i,kolvo : integer;

begin

ind:=n;

i:=0;

kolvo:=0; {обнуляем счётчик КОЛ-ва, требуемого в задаче}

if ind=nil then writeln ('List is empty')

else begin

while ind<>nil do begin {начало считывания списка}

i:=i+1;

if i=1 then slotek2:=ind^.ini else

begin slotek1:=slotek2; slotek2:=ind^.ini; end; {считываем 2 слова со списка}

if i<>1 then

if slotek1[1]=slotek2[1] then {если выполняется требуемое условие "начинаются с той же литеры"}

inc(kolvo); {то увеличиваем счётчик КОЛ-ВА}

ind:=ind^.next;

end;

end;

veiwLkolvo:=kolvo; {присваеваем это КОЛ-ВО самой функции}

end; {КОНЕЦ ФУНКЦИИ }

var sl:slovo; i,n:integer;

L:link;

begin

write('Vvedite kol-vo slov v spiske: '); readln(n); {считываем размер списка}

writeln('Vvedite sam SPISOK L: ');

for i:=1 to n do begin

write(i,' slovo= '); readln(sl); add(L,sl,i); end; {считываем сам список}

writeln('OTVET= ',veiwLkolvo(L)); {выводим РЕЗУЛЬТАТна экран}

readln; readln;

end.