uses CRT; type plist=^list; list=record b:real; next:plist; end; plist3=^list3; list3=record b:char; next:plist3; end; {----------------------------------} function p1(l:plist; e:list):boolean; begin if l=nil then p1:=false else begin if l^.b = e.b then p1:=true else p1:=p1(l^.next, e); end; end;{p1} {----------------------------------} procedure p2(l:plist;e:list;var num:byte); begin if l<>nil then begin if l^.b=e.b then inc(num); p2(l^.next,e,num); end; end;{p2} {----------------------------------} function p11(l:plist):boolean; {var num:byte; } begin if l<>nil then begin if l^.b=l^.next ^.b then p11:=true; exit end else p11:=p11(l^.next) else p11:=false end; end;{p11} {----------------------------------} procedure p3(l:plist;var MAX:real); begin if l <>nil then begin if l^.b > max then max:=l^.b ; p3(l^.next,max); end; end;{p3} {----------------------------------} procedure p4(l:plist3); begin if l<>nil then begin p4(l^.next); write(l^.b); end; end;{p4} {----------------------------------} procedure p5(l:plist;e1,e2:list); begin if l<>nil then begin if l^.b=e1.b then l^.b:=e2.b; p5(l^.next,e1,e2); end; end;{p5} {----------------------------------} procedure p6(l:plist;e:list); var lishniy:plist; begin if l^.next<>nil then begin if l^.next^.b=e.b then begin lishniy:=l^.next; l^.next:=l^.next^.next; dispose(lishniy); end else p6(l^.next,e) end; end;{p6} {----------------------------------} procedure p7(l:plist;e:list); var lishniy:plist; begin if l^.next<>nil then begin if l^.next^.b=e.b then begin lishniy:=l^.next; l^.next:=l^.next^.next; dispose(lishniy); end; p7(l^.next,e) end; end;{p7} {----------------------------------} function p8(l:plist):plist; var n:plist; begin if l <> nil then begin new(n); n^.b:=l^.b; n^.next := p8(l^.next); end; p8:=n; end;{p8} {----------------------------------} procedure p9(l:plist;e:list); var n:plist; begin if l<>nil then begin if l^.b=e.b then begin new(n); n^.b:=e.b; n^.next:=l^.next; l^.next:=n; p9(l^.next^.next,e); end else p9(l^.next,e); end; end;{p9} {----------------------------------} function p10(l:plist;sum:real;num:word):real; begin if l<>nil then p10:=p10(l^.next,sum+l^.b,num+1) else p10:=sum/(num-1); end; {----------------------------------} function NewList:plist; var NN,p : plist; i: byte; begin nn:=nil;p:=nil; for i := 1 to 10 do begin New(p); Read(p^.b); P^.next:=nn; nn:=p; end; Newlist:=NN; end; {NewList} {--------------} function NewList2:plist3; var NN,p : plist3; i: byte; begin nn:=nil;p:=nil; for i := 1 to 10 do begin New(p); Read(p^.b); P^.next:=nn; nn:=p; end; Newlist2:=NN; end; {NewList} {--------------} Procedure WriteList(L:plist); var p : plist; begin p:=l; while p <> nil do begin Write(p^.b:0:2,' '); p:=p^.next; end; end;{WriteList} var l1,LL : plist; l2 : plist3; e,e2 : list; k : byte; m : real; begin L1:=nil;ll:=nil; WriteLN('Введите 10 чисел'); LL:=NewList; Write('Введите зн-е e'); Read(e.b); if p1(LL,e) then begin k:=0; p2(LL,e,k); WriteLn('Найдено!, ',k,' раз'); end else WriteLn('Не найдено!'); m := LL^.b; {-------------------------------------} p11(ll) ; writeln(p11(ll)) ; p3(LL,m); WriteLn('Максимум: ',m:0:2); WriteLn('Введите 10 символов (по очереди!)'); l2:=NewlIst2; Write('А теперь обратно: '); p4(l2); writeln; WriteLn('Список до:'); WriteList(LL); writeln; WriteLn('Введите что и на что заменять:'); Read(e.b,e2.b); p5(LL,e,e2); WriteLn('Список после замены:'); WriteList(LL); writeln; WriteLn('Введите что удалять:'); Read(e.b); p6(LL,e); WriteLn('Список после одного удаления:'); WriteList(LL); writeln; WriteLn('Введите что удалять:'); Read(e.b); p7(LL,e); WriteLn('Список после всех удалений:'); WriteList(LL); writeln; l1:=p8(LL); WriteLn('А теперь L1'); WriteList(LL); writeln; WriteLn('Введите что удваивать:'); Read(e.b); p9(LL,e); WriteLn('Список после:'); WriteList(LL); writeln; WriteLn('Средн. арифм.: ',p10(LL,0,1):0:2); end.