VPF::[Turbo Pascal] Динамические структуры данных

Dower

Дата 29.3.2010, 21:18 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 17.1.2010

Репутация: нет
Всего: нет

Нужно написать программу, работающую по следующему меню:
1. Добавить в очередь
2. Выбрать из очереди
3. Распечатать очередь

например: очередь за талонами к врачу (имя, фамилия).

И если это возможно, хотя бы вкратце поясните код.

t_gran

Дата 30.3.2010, 03:11 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 621
Регистрация: 13.11.2007
Где: г.Усть-Илимск

Репутация: 33
Всего: 37

Код


type
   TPNode= ^TNode;
   TNode= record
      name, surname: string;  // Имя, фамилия
      next: TPNode;           // Указатель на следующий узел
   end;
   
   TQueue= record             // Непосредственно сама очередь
      head, tail: TPNode;     // Указатель на голову и хвост
   end;

{-----------------------------------------------}
// Добавление в конец (хвост) очереди
procedure Push(var theQueue: TQueue; theName, theSurname: string);
var
   node: TPNode;
begin
   new(node);                    // Новый узел
   node^.name:= theName;         // Задаём имя новому узлу
   node^.surname:= theSurname;   // Задаём фамилию
   node^.next:= nil;             // Т.к. этот узел теперь будет последним, то значит
                                 // он не на что не ссылается.
   if (theQueue.tail = nil) then // Вариант когда в очереди нет ни одного элемента
   begin
      theQueue.head:= node;      // Соответственно и голова и хвост будут указывать
      theQueue.tail:= node;      // на вновь созданный узел
   end
   else
   begin
      theQueue.tail^.next:= node;// Иначе просто добавляем в хвост очереди
      theQueue.tail:= node;
   end;
end;
{-----------------------------------------------}
// Извлекаем с начала очереди, если извлечение прошло удачно, то
// возвращаем true, иначе false
function Pop(var theQueue: TQueue; var theName, theSurname: string): boolean;
var
   node: TPNode;
begin
   if (theQueue.head = nil) then    // Если очередь пуста, то выходим
   begin
      Pop:= false;
      exit;
   end;
   node:= theQueue.head;            // Переприсваеваем указатель на удаляемый элемент
   theQueue.head:= node^.next;      // Указатель на голову в списке спускаем ниже
   if (theQueue.head = nil) then    // Если удаляемый элемент был последний в очереди
      theQueue.tail:= nil;
   theName:= node^.name;
   theSurname:= node^.surname;
   dispose(node);                   // Удаляем узел
   Pop:= true;
end;
{-----------------------------------------------}
procedure Print(theQueue: TQueue);
begin
   while (theQueue.head <> nil) do
   begin
      writeln(theQueue.head^.name, ' ', theQueue.head^.surname);
      theQueue.head:= theQueue.head^.next;
   end;
end;
{-----------------------------------------------}

var
   name, surname: string;
   queue: TQueue;

begin
   queue.head:= nil;
   queue.tail:= nil;
   writeln('Test: Push -> Pop');
   Push(queue, 'A_name', 'A_surname');
   Push(queue, 'B_name', 'B_surname');
   Push(queue, 'C_name', 'C_surname');
   while (Pop(queue, name, surname)) do
      writeln(name, ' ', surname);
   writeln;
   writeln('Test: Push -> Print');
   Push(queue, 'D_name', 'D_surname');
   Push(queue, 'E_name', 'E_surname');
   Push(queue, 'F_name', 'F_surname');
   Print(queue);
end.

--------------------

Я знаю, что ничего не знаю© Сократ
user posted image

Dower

Дата 30.3.2010, 07:26 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 17.1.2010

Репутация: нет
Всего: нет

У меня она почему-то не запускается, но и не выдает никаких ошибок.

t_gran

Дата 30.3.2010, 07:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 621
Регистрация: 13.11.2007
Где: г.Усть-Илимск

Репутация: 33
Всего: 37

Цитата

У меня она почему-то не запускается

Да ну?!

Вы в этом точно уверены!? smile

Если вы используете TP7, то вы должны знать, что среда после выполнения программы не делает задержку и чтобы посмотреть результат выполнения то необходимо всего лишь нажать Alt+F5. Но многие энтузиасты делают проще, они просто ставят задержку типа какого-нибудь readkey. Если же вы используете FPC (как и я), то вы должны знать, что консольная программа всю информацию выводит в консоль, а это значит её нужно запустить через cmd, или опять же делать искусственную задержку.

В доказательство что программа работоспособна прикрепляю исходник с бинарником.

Присоединённый файл ( Кол-во скачиваний: 8 )

queue.zip 13,99 Kb

--------------------

Я знаю, что ничего не знаю© Сократ
user posted image

Dower

Дата 31.3.2010, 14:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 17.1.2010

Репутация: нет
Всего: нет

Может я что не так понял в задании или не правильно разобрался с кодом вашей программы, но разве в программе не должно присутствовать меню. Я думал будет меню и при нажатии определенной цифры должно предлагаться либо добавить новую запись в очередь, либо выбрать, либо распечатать.

Это сообщение отредактировал(а) Dower - 31.3.2010, 14:49

t_gran

Дата 1.4.2010, 04:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 621
Регистрация: 13.11.2007
Где: г.Усть-Илимск

Репутация: 33
Всего: 37

Цитата

Наверное, но в чём проблема-то? Я думал у вас ступор с самими списками(очередями), а не с какими-то меню. А вам тут всё нужно на блюдечке с голубой каёмочкой.

Код


uses crt;

type
   TPNode= ^TNode;
   TNode= record
      name, surname: string;  // Имя, фамилия
      next: TPNode;           // Указатель на следующий узел
   end;
   
   TQueue= record             // Непосредственно сама очередь
      head, tail: TPNode;     // Указатель на голову и хвост
   end;

{-----------------------------------------------}
// Добавление в конец (хвост) очереди
procedure Push(var theQueue: TQueue; theName, theSurname: string);
var
   node: TPNode;
begin
   new(node);                    // Новый узел
   node^.name:= theName;         // Задаём имя новому узлу
   node^.surname:= theSurname;   // Задаём фамилию
   node^.next:= nil;             // Т.к. этот узел теперь будет последним, то значит
                                 // он не на что не ссылается.
   if (theQueue.tail = nil) then // Вариант когда в очереди нет ни одного элемента
   begin
      theQueue.head:= node;      // Соответственно и голова и хвост будут указывать
      theQueue.tail:= node;      // на вновь созданный узел
   end
   else
   begin
      theQueue.tail^.next:= node;// Иначе просто добавляем в хвост очереди
      theQueue.tail:= node;
   end;
end;
{-----------------------------------------------}
// Извлекаем с начала очереди, если извлечение прошло удачно, то
// возвращаем true, иначе false
function Pop(var theQueue: TQueue; var theName, theSurname: string): boolean;
var
   node: TPNode;
begin
   if (theQueue.head = nil) then    // Если учередь пуста, то выходим
   begin
      Pop:= false;
      exit;
   end;
   node:= theQueue.head;            // Переприсваеваем указатель на удляемый элемент
   theQueue.head:= node^.next;      // Указатель на голову в списке спускаем ниже
   if (theQueue.head = nil) then    // Если удаляемый элемент был последний в очереди
      theQueue.tail:= nil;
   theName:= node^.name;
   theSurname:= node^.surname;
   dispose(node);                   // Удоляем узел
   Pop:= true;
end;
{-----------------------------------------------}
procedure Print(theQueue: TQueue);
begin
   while (theQueue.head <> nil) do
   begin
      writeln(theQueue.head^.name, ' ', theQueue.head^.surname);
      theQueue.head:= theQueue.head^.next;
   end;
end;
{-----------------------------------------------}
procedure PrintHead(theCaption: string);
var
   i: integer;
begin
   writeln;
   writeln(theCaption);
   for i:= 1 to length(theCaption) do
      write('-');
   writeln;
end;
{-----------------------------------------------}
var
   ch: char;
   name, surname: string;
   queue: TQueue;

begin
   queue.head:= nil;
   queue.tail:= nil;
   writeln('[a]dd [d]elete [p]rint [q]uit');
   repeat
      ch:= readkey;
      case ch of
         'a':  begin
                  PrintHead('APPEND');
                  write('name: ');
                  readln(name);
                  write('surname: ');
                  readln(surname);
                  Push(queue, name, surname);
               end;
         'd':  begin
                  PrintHead('DELETE');
                  if (Pop(queue, name, surname)) then
                     writeln('Ok')
                  else
                     writeln('Error');
               end;
         'p':  begin
                  PrintHead('PRINT');
                  Print(queue);
               end;
      end;
   until (ch = 'q');
end.

Присоединённый файл ( Кол-во скачиваний: 9 )

queue.zip 16,49 Kb

--------------------

Dower

Дата 1.4.2010, 06:06 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 55
Регистрация: 17.1.2010

Репутация: нет
Всего: нет

Огромное вам спасибо за решение.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »