Pascal: динамические структуры

Задача 1.

type telem='a'..'z'.
            list=^node;
            node= record
                   info:telem;
                   next:list
                  end;

type telem='a'..'z'.

list=^node;

node= record

info:telem;

next:list

end;

Пусть E1 и E2 – данные типа telem.
Описать функцию или процедуру, которая :

а) заменяет в списке L все вхождения Е1 и Е2;
б) проверяет, упорядочены ли элементы списка L по алфавиту.

а)

type telem='a'..'z';
list=^node;
node= record  info : telem;
 next : list  end; var s,l : list;
 x,e,e1 : telem;
    n,i : integer;
procedure change (l : list; e,e1: telem);
var p:list;                                                {ссылка на очередное звено}
begin
      p:=L;
      while p&lt;&gt;nil do
      begin
             if p^.info=e then p^.info:=e1;
             p:=p^.next                                 {переход к следующему звену}
     end;
end;
procedure out_spisok(l : list);                {выводит список на экран}
begin
      while l&lt;&gt; 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);
                                                                   {заменяем элемент Е на Е1}
      writeln('Введите элемент, который Вы хотите заменить');
      readln(e);
      writeln('Введите элемент, на который Вы хотите заменить');
      readln(e1); change (l,e,e1);
      writeln('Полученный список');
      out_spisok(l);
                                                             {освобождаем динамическую память}
      while l&lt;&gt; nil do
      begin s:=l^.next; dispose(l); l:=s; end;
end.

type telem='a'..'z';

list=^node;

node= record info : telem;

next : list end; var s,l : list;

x,e,e1 : telem;

n,i : integer;

procedure change (l : list; e,e1: telem);

var p:list; {ссылка на очередное звено}

begin

p:=L;

while p<>nil do

begin

if p^.info=e then p^.info:=e1;

p:=p^.next {переход к следующему звену}

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);

{заменяем элемент Е на Е1}

writeln('Введите элемент, который Вы хотите заменить');

readln(e);

writeln('Введите элемент, на который Вы хотите заменить');

readln(e1); change (l,e,e1);

writeln('Полученный список');

out_spisok(l);

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

while l<> nil do

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

end.

б)

type telem='a'..'z';
            list=^node;
            node= record
                   info : telem;
                   next : list
                  end;
var s,l : list;
    x : telem;
    n,i : integer;

function sort(l : list) : boolean;
var p,q : list;                                          {ссылка на пару соседних звеньев}
      ok : boolean;
begin
      ok:=true; p:=L;
{nil или ссылка на 1-е звено}    if p&lt;&gt;nil then   begin q:=p^.next;
{nil или ссылка на 2-е звено}     while (q&lt;&gt;nil) and ok do
                                 begin
                                        ok:=p^.info&lt;=q^.info;
                                        p:=q; q:=q^.next            {переход к след. паре}
                                 end
                        end;
      sort:=ok
end;

procedure out_spisok(l:list);
begin
   while l&lt;&gt; 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&lt;&gt; nil do
   begin  s:=l^.next; dispose(l); l:=s; end;
end.

type telem='a'..'z';

list=^node;

node= record

info : telem;

next : list

end;

var s,l : list;

x : telem;

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.

Задача 2.

Описать процедуру, которая удаляет из непустого списка l последний элемент.

type list=^node;
     node= record
           info : integer;
           next : list
           end;
var s,l : list;
    x : integer;
    n,i : integer;

procedure del(var l : list);
var p,q : list;
begin
       if l=nil then {удалять нечего} else
       if l^.next=nil {в списке один элемент} then  begin dispose(l);l:=nil end
       else begin {поиск предпослед.(p) и послед.(q) звеньев: }
              p:=l; q:=p^.next;
              while q^.next&lt;&gt;nil do
                        begin p:=q; q:=q^.next end;
             {удаление последнего звена:}
             dispose(q); p^.next:=nil
             end;
end;

procedure out_spisok(l : list);
begin
   while l&lt;&gt; 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); del(l);
   writeln('Полученный список');
   out_spisok(l);
                                                         {освобождаем динамическую память}
   while l&lt;&gt; nil do
        begin s:=l^.next; dispose(l); l:=s; end;
end.

type list=^node;

node= record

info : integer;

next : list

end;

var s,l : list;

x : integer;

n,i : integer;

procedure del(var l : list);

var p,q : list;

begin

if l=nil then {удалять нечего} else

if l^.next=nil {в списке один элемент} then begin dispose(l);l:=nil end

else begin {поиск предпослед.(p) и послед.(q) звеньев: }

p:=l; q:=p^.next;

while q^.next<>nil do

begin p:=q; q:=q^.next end;

{удаление последнего звена:}

dispose(q); p^.next:=nil

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); del(l);

writeln('Полученный список');

out_spisok(l);

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

while l<> nil do

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

end.

Oh, MSBRO !

Сетевые заметки системного администратора

Pascal: динамические структуры