Вторник, 14.05.2024
Pascal 4 All
Меню сайта
Категории каталога
Одномерные массивы [4]
Задачи на работу с одномерными массивами
Матрицы [5]
Двумерные массивы
Сортировка [0]
Варианты сортировки
Динамическое программирование [1]
Программирование динамических структур. Использование HEAP
Наш опрос
А вы знали, что кликнув на обьявление в правом блоке раз в день Вы поможете сайту?
Всего ответов: 332

Главная » Статьи » Массивы » Динамическое программирование

  


Генеалогическое дерево

Code

Program Genealogic;
Uses CRT;
Const
  _MAX_ITEMS = 32;
  _SAVE_FILE = 'tree.txt';

Type linkNode = ^Node;
  Node = record
  next: linkNode;
  parId: Integer;
  id: Integer;
  Name: String;
  end;
Var
  item: linkNode;
  top: linkNode;
  c: Char;
  lastId: Integer;
  intList: Array[0.._MAX_ITEMS] of Integer;

Function _getNameFromID(id: Integer): String;
Var t: linkNode;
Begin
t := top;
Repeat
if (t^.id = id) then
  Begin
  _getNameFromID := t^.name;
  Exit;
  end;
t := t^.next;
Until (t = nil);
_getNameFromID := ' - root - ';
End;

Function _getIdFromNAME(name: String): Integer;
Var t: linkNode;
Begin
t := top;
Repeat
if (t^.name = name) then
  Begin
  _getIdFromName := t^.id;
  break;
  End;
t := t^.next;
Until (t = nil);
End;

Procedure _getChildsFromId(id: Integer; var intList: Array of Integer);
Var t: linkNode;
  c: Integer;
Begin
t := top;
c := 0;
Repeat
if (t^.parId = id) then
  Begin
  inc(c);
  intList[c] := t^.id;
  End;
t := t^.next;
Until t = nil;
intList[0] := c;
End;

Function _getParentOfID(id: Integer): Integer;
Var t: linkNode;
Begin
t := top;
Repeat
if (t^.id = id) then
  Begin
  _getParentOfID := t^.parID;
  Exit;
  End;
t := t^.next;
Until (t = nil);
End;

Procedure ListPeople;
Var t: linkNode;
Begin
t := top;
if (t = nil) then Exit;
Repeat
Writeln(t^.name, ' ID = ', t^.id);
t := t^.next;
Until t = nil;
End;

Procedure SaveToFile;
Var t: linkNode;
  f: Text;
Begin
t := top;
Assign(f, _SAVE_FILE);
ReWrite(f);
While (t <> nil) do
  Begin
  Writeln(f, t^.id,'-',t^.parID,'-',t^.name);
  t := t^.next;
  End;
Close(f);
Writeln('EXPORT DONE');
ReadKey;
End;

Procedure DeleteItem;
Var prev, cur, next: linkNode;
  id: Integer;
Begin
ClrScr;
ListPeople;
Write('Delete item: ');
Readln(id);
prev := top;
cur := top;
next := cur^.next;
Repeat
if (cur^.id = id) then
  Begin
  if (top = cur) then
  Begin
  dispose(top);
  top := cur;
  Break;
  End
  Else
  Begin
  dispose(cur);
  prev^.next := next;
  Break;
  End;
  End;
  prev := cur;
  cur := next;
  next := next^.next;

Until prev = nil;
End;

Procedure LoadFromFile;
Var f: Text;
  s, st: String;
  ln: linkNode;
  id_, parID_,c: Integer;
Begin
ln := nil;
Assign(f, _SAVE_FILE);
ReSet(f);
lastID := 0;
While (not(Eof(f))) do
  Begin
  Readln(f, s);
  st := Copy(s, 1, Pos('-',s)-1);
  Val(st, id_, c); {ID}
  Delete(s, 1, Pos('-',s));
  st := Copy(s, 1, Pos('-',s)-1);
  Val(st, parID_, c); {ParID}
  Delete(s, 1, Pos('-',s));
  New(item);
  inc(lastID);
  item^.id := id_;
  item^.parID := parID_;
  item^.name := s;
  item^.next := ln;
  ln := item;
  End;
top := ln;

Writeln('LOAD FROM FILE - DONE');
Readkey;
Close(f);
End;

Procedure AddNewPeople;
Var newID: Integer;
  newSt: String;
Begin
if (lastId >= _MAX_ITEMS) then
  Begin
  Writeln('LIMIT ELEMENTS OVERLOAD');
  Readkey;
  Exit;
  End;
ListPeople;
New(item); {Create}
item^.next := top;
top := item;
Write('Name of Element: ');
Readln(top^.name);

Write('Who is parent [ID] (0 .. ',lastID,'): ');
Readln(top^.parId);
inc(lastID);
top^.id := lastID;
End;

Procedure WriteTree;
Var
  t: linkNode;
Begin
t := top;
if t = nil then Exit;
Repeat
Writeln(t^.id,':',t^.name,' child of ',_getNameFromID(t^.parID));
t := t^.next;
Until (t = nil);
t := top;
ReadKey;
End;

Procedure Calculate;
Var name: String;
  i: Byte;
  t: linkNode;
Begin
ListPeople;
Write('Name: ');
Readln(name);
Writeln;
Writeln('CHILDS:');
_getChildsFromId(_getIdFromName(name), intList);
For i := 1 to intList[0] do
  Begin
  Writeln(_getNameFromID(intList[i]),' - ',intList[i], ' is child of ',name);
  End;

Writeln;
Writeln('GRAND CHILDS:');
t := top;
Repeat
For i := 1 to intList[0] do
  Begin
  if (t^.parId = intList[i]) then
  Begin
  Writeln(_getNameFromID(t^.id),' - is a grandchild of ',name);
  End;
  End;
t := t^.next;
Until (t = nil);
Writeln;
Writeln('BROTHERS');
i := _getParentOfId(_getIdFromName(name));
_getChildsFromId(i, intList);
For i := 1 to intList[0] do
  Begin
  if (_getNameFromID(intList[i]) = name) then Continue;
  Writeln(_getNameFromID(intList[i]),' - ',intList[i], ' is brother/sister of ',name);
  End;
Writeln;
Writeln('PARENTS');
Writeln(_getNameFromId(_getParentOfId(_getIdFromName(name))));
Writeln;
Writeln('GRANDPARENTS');
Writeln(_getNameFromId(_getParentOfId(_getParentOfId(_getIdFromName(name)))));

ReadKey;
End;

Begin
lastId := 0;
top := nil;
top^.next := nil;
Repeat
ClrScr;
Writeln('[A] Add new people');
Writeln('[D] Delete people');
Writeln('[W] Write tree');
Writeln('[S] Save to file');
Writeln('[L] Load from file');
Writeln('[C] Calculate!!!');
Writeln('--------------------------');
Writeln('[Q] Quit');
c := ReadKey;
Case c of
'a': AddNewPeople;
'd': DeleteItem;
'w': WriteTree;
's': SaveToFile;
'l': LoadFromFile;
'c': Calculate;
End;
Until c = 'q';
End.

Источник:

Категория: Динамическое программирование | Добавил: Seqular (20.12.2011) | Автор: seqular
Просмотров: 2291 | Рейтинг: 5.0/2 |

Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Форма входа
Поиск
Друзья сайта
Статистика
Copyright MyCorp © 2024
Используются технологии uCoz
style=