old/PAS/!Other/S.PAS

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.