Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.12.2012, 15:06   #1
bfgman
Новичок
Джуниор
 
Регистрация: 27.12.2012
Сообщений: 1
Вопрос Двунаправленная очередь - упорядочить + др..

1)Создать двунаправленную очередь символов, распечатать в порядке поступления. За каждой буквой включить цифру, начиная с "5"(после "9" - "5"), а все символы, не относящиеся к буквам или цифрам удалить. Обработанный список упорядочить по убыванию.

2)Создать однонаправленное кольцо, упорядочивая его, при создании, по убыванию.Распечатать. Обработать по такому - же заданию. Распечатать.


вот набросал для очереди - проверьте на наличие ошибок пожалуйста
Код:
program DSD2;

uses crt;
type
  td = char;
  pobj2 = ^obj2;
  obj2 = record
    l, r: pobj2;
    d: td;
  end;

function inoch2(var b, e: pobj2; al: pobj2; nd: td): pobj2;
var
  t, ar: pobj2;
begin
  new(t);
  t^.d := nd;
  t^.l := al;
  if al = nil then
  begin
    ar := b;
    b := t;
  end
   else
  begin
    ar := al^.r;
    al^.r := t;
  end;
  t^.r := ar;
  if al = e then e := t
  else ar^.l := t;
  inoch2 := t;
end;

procedure outsp2(p: pobj2);
var
  t: pobj2;
begin
  if p <> nil then
  begin
    t := p;
    while t <> nil do
    begin
      write(t^.d, ' ');
      t := t^.r;
    end;
  end
  else
    write('Error');
end;

procedure deloboch2(var b, e: pobj2; del: pobj2);
var
  al, ar: pobj2;
begin
  if (b <> nil) and (del <> nil) then
  begin
    al := del^.l;
    ar := del^.r;
    if del = b then b := ar
    else al^.r := ar;
    if del = e then e := al
    else ar^.l := al;
    dispose(del);
  end
  else writeln('Error');
end;

var
  b, e, tek, t: pobj2; x, max: td;

begin
  b:= nil;
  e := nil;
  
  checkeof := true;
  while not eof do
  begin
    read(x);
    inoch2(b, e, e, x);
  end;
  clrscr;
  outsp2(b);
  
writeln;
  t:= b;

i:='5';
while t<>nil do
begin
  if (t^.d in ['a'..'z']) or  (t^.d in ['0'..'9']) then begin
    if t^.d in ['a'..'z'] then
    begin
    tek:=t;
     inoch2(b, e, tek, i);
     i:=succ(i);
    end;
    if i>'9' then
    i:='5';
     tek:=t;
     t:=t^.r;
    end
   else
    begin
     t:=t^.r;
     deloboch2(b,e,t);
                    end;
end;
outsp2(b);
     writeln;
end.
вот для кольца - проверьте тоже пожалуйста

Код:
uses crt;

type td=char;
     pobj=^obj;
     obj=record
           r:pobj;
           d:td;
          end;

var k,t,al,tek:pobj;
    x:td;
    M1,M2:set of td;


procedure Initk(var k:pobj);
begin
new(k);
k^.r:=k;
end;


function Ink(k,al:pobj; nd:td):pobj;
var t:pobj;
begin
new(t);
t^.d:=nd;
if al=nil then al:=k;
t^.r:=al^.r;
al^.r:=t;
Ink:=t;
end;


procedure outk(k:pobj);
var t:pobj;
begin
  if k<>k^.r then begin
  t:=k^.r;
  while t<>k do begin
    write(t^.d,' ');
    t:=t^.r;
    end;
  end else writeln('Spisok pust');
end;


procedure Delobk(k,al:pobj);
var del:pobj;
begin
 if k<>k^.r then begin
  del:=al^.r;
  if k=del then del:=k^.r;
  al^.r:=del^.r;
  dispose(del);
 end else writeln('Spisok pust. Udalenie nevozmozhno');
end;


begin
clrscr;
checkeof:=true;
Initk(k);
writeln('Vvedite kolco: ');
while not(eof) do begin
  readln(x);
  al:=k;
  t:=k^.r;
  while (t<>k)AND(x<t^.d) do begin
    al:=t;
    t:=t^.r;
    end;
  Ink(k,al,x);
  end;
  clrscr;
write('Vashe kolco: ');
outk(k);
readkey;
al:=k;
t:=k^.r;

i:='5';
while t<>k do
begin
  tek:=t;
  t:=t^.r;
begin
  if (t^.d in ['a'..'z']) or  (t^.d in ['0'..'9']) then begin
    if t^.d in ['a'..'z'] then
    begin
     t:=ink(k,tek,i);
     i:=succ(i);
    end;
    if i>'9' then
    i:='5';
     al:=t;
     t:=t^.r;
    end
   else
    begin
     t:=t^.r;
     delobk(k,al);
                    end;
end;
outk(k);
     writeln;
end;
end.

Последний раз редактировалось bfgman; 27.12.2012 в 18:48. Причина: набросал
bfgman вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Очередь С++ vadiprog Помощь студентам 0 24.04.2012 00:48
Очередь Artem_Kow C# (си шарп) 16 05.04.2012 22:19
очередь qwer1994 Паскаль, Turbo Pascal, PascalABC.NET 0 29.02.2012 23:12
Очередь, упорядочить... kapkan Помощь студентам 2 19.05.2010 09:19