48622 (Разработка программ с использованием динамической памяти), страница 2

2016-07-30СтудИзба

Описание файла

Документ из архива "Разработка программ с использованием динамической памяти", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.

Онлайн просмотр документа "48622"

Текст 2 страницы из документа "48622"

c:char;

n,m:integer;

V:array[1..max] of byte;

{---------добавляем вершину в граф-------------}

procedure AddVer(n:integer);

var

p:TUk;

begin

if (Head=Nil) then

begin

New(Head);

Head^.Inf:=n;

Head^.Left:=Nil;

Head^.Down:=Nil;

end else begin

p:=Head;

while ((p^.Down<>Nil)and(p^.Inf<>n)) do p:=p^.Down;

if (p^.Inf=n) then WriteLn('Такая вершина уже есть!!!')

else begin

New(p^.Down);

p^.Down^.Inf:=n;

p^.Down^.Left:=Nil;

p^.Down^.Down:=Nil;

end;

end;

end;

{-------добавляем дугу в граф----------------------}

procedure AddDug(n,m:integer);

var

p,p1:TUk;

p2:TUk1;

begin

if (Head=Nil) then WriteLn('В графе нет ни одной вершины!!!')

else begin

p:=Head;

while ((p<>Nil)and(p^.Inf<>n)) do p:=p^.Down;

if (p=Nil) then WriteLn('В графе отсутствует указанная вершина источник!!!')

else begin

p1:=Head;

while ((p1<>Nil)and(p1^.Inf<>m)) do p1:=p1^.Down;

if (p1=Nil) then WriteLn('В графе отсутствует указанная вершина сток!!!')

else begin

if (p^.Left=Nil) then

begin

New(p^.Left);

p^.Left^.Inf:=m;

p^.Left^.Next:=Nil;

end else begin

p2:=p^.Left;

while ((p2^.Next<>Nil)and(p2^.Inf<>m)) do p2:=p2^.Next;

if (p2^.Inf=m) then WriteLn('Указанная дуга уже существует!!!')

else begin

New(p2^.Next);

p2^.Next^.Inf:=m;

p2^.Next^.Next:=Nil;

WriteLn('Дуга добавлена!!!');

end;

end;

end;

end;

end

end;

{--удаляем список дуг--}

procedure DelList(p:TUk1);

var p1:TUk1;

begin

while (p<>Nil) do

begin

p1:=p;

p:=p^.Next;

Dispose(p1);

end;

end;

{---------удаляем вершину из графа---------}

procedure DelVer(n:integer);

var

p,p1:TUk;

p2,p3:TUk1;

begin

if (Head=Nil) then WriteLn('В графе нет ни одной вершины!!!')

else begin

p:=Head;

if (p^.Inf=n) then

begin

Head:=Head^.Down;

DelList(p^.Left);

Dispose(p);

end else begin

while ((p^.Down^.Inf<>n)and(p^.Down<>Nil)) do p:=p^.Down;

if (p^.Down=Nil) then WriteLn('В графе нет указанной вершины!!!')

else begin

DelList(p^.Down^.Left);

p1:=p^.Down;

p^.Down:=p^.Down^.Down;

Dispose(p1);

end;

end;

p:=Head;

while (p<>Nil) do

begin

if (p^.Left^.Inf=n) then

begin

p2:=p^.Left;

p^.Left:=p^.Left^.Next;

Dispose(p2);

end else begin

p2:=p^.Left;

while ((p2^.Next<>Nil)and(p2^.Next^.Inf=n)) do p2:=p2^.Next;

if(p2^.Next^.Inf=n) then

begin

p3:=p2^.Next;

p2^.Next:=p2^.Next^.Next;

Dispose(p3);

end;

end;

p:=p^.Down;

end;

end;

end;

{------удаляем дугу графа--------}

procedure DelDug(n,m:integer);

var

p,p1:TUk;

p2,p3:TUk1;

begin

if (Head=Nil) then WriteLn('В графе нет ни одной вершины!!!')

else begin

p:=Head;

while ((p^.Inf<>n)and(p<>Nil)) do p:=p^.Down;

if (p=Nil) then WriteLn('В графе отсутствует указанная вершина источник')

else begin

p1:=Head;

while ((p1<>Nil)and(p1^.Inf<>m)) do p1:=p1^.Down;

if (p1=Nil) then WriteLn('В графе отсутствует указанная вершина сток!!!')

else begin

p2:=p^.Left;

if (p^.Left^.Inf=m) then

begin

p3:=p^.Left;

p^.Left:=p^.Left^.Next;

Dispose(p3);

end else begin

while ((p2^.Next^.Inf<>m)and(p2^.Next<>Nil)) do p2:=p2^.Next;

if (p2=Nil) then WriteLn('Указанного ребра нет в графе!!!')

else begin

p3:=p2^.Next;

p2^.Next:=p2^.Next^.Next;

Dispose(p3);

end;

end;

end;

end;

end;

end;

{---Вывод графа в виде матрицы смежности------}

procedure PrintGraph;

var

i,j,n:integer;

M:array [1..max,1..max] of byte;

p:TUk;

p2:TUk1;

begin

for i:=1 to max do

for j:=1 to max do M[i,j]:=0;

n:=0;

if (Head=Nil) then WriteLn('В графе нет ни одной вершины!!!')

else begin

p:=Head;

while (p<>Nil) do

begin

inc(n);

p2:=p^.Left;

while (p2<>Nil) do

begin

M[p^.Inf,p2^.Inf]:=1;

p2:=p2^.Next;

end;

p:=p^.Down;

end;

end;

for i:=1 to n do

begin

for j:=1 to n do Write(M[i,j]:2);

WriteLn;

end;

end;

{-----находим все источники орграфа----}

procedure FindIstok;

var

f:boolean;

i,k:integer;

Is:array[1..max*max] of byte;

p,p1:TUk;

p2:TUk1;

begin

for i:=1 to max*max do Is[i]:=0;

if (Head=Nil) then WriteLn('В графе нет ни одной вершины!!!')

else begin

k:=0;

p:=Head;

while (p<>Nil) do

begin

if (p^.Left<>Nil) then

begin

f:=true;

p1:=Head;

while (p1<>Nil) do

begin

p2:=p1^.Left;

while ((f)and(p2<>Nil)) do

begin

if p2^.Inf=p^.Inf then f:=false;

p2:=p2^.Next;

end;

p1:=p1^.Down;

end;

if (f=true) then

begin

inc(k);

Is[k]:=p^.Inf;

end;

end;

p:=p^.Down;

end;

end;

for i:=1 to k do Write(Is[i]:2);

end;

procedure Menu;

begin

WriteLn('1-Показать матрицу смежности графа');

WriteLn('2-Добавить вершину в граф');

WriteLn('3-Добавить дугу в граф');

WriteLn('4-Удалить вершину графа');

WriteLn('5-Удалить дугу графа');

WriteLn('6-Найти источники орграфа');

WriteLn('7-Выход');

end;

{--------основная программа--------}

begin

ClrScr;

repeat

clrscr;

Menu;

c:=ReadKey;

case c of

'1': begin

ClrScr; PrintGraph; ReadKey;

end;

'2': begin

ClrScr;

Write('Введите добавляемую вершину : ');

ReadLn(n); AddVer(n);

end;

'3': begin

ClrScr;

Write('Введите вершину источник дуги : ');

ReadLn(n);

Write('Введите вершину сток дуги : ');

ReadLn(m); AddDug(n,m);

end;

'4': begin

ClrScr;

Write('Введите удаляемую вершину : ');

ReadLn(n); DelVer(n);

end;

'5': begin

ClrScr;

Write('Введите вершину источник удаляемой дуги : ');

ReadLn(n);

Write('Введите вершину сток удаляемой дуги : ');

ReadLn(m); DelDug(n,m);

end;

'6': begin

ClrScr; FindIstok; ReadKey;

end;

'7': begin

halt;

end;

end;

until ord(c)=27;

end.

Свежие статьи
Популярно сейчас
Почему делать на заказ в разы дороже, чем купить готовую учебную работу на СтудИзбе? Наши учебные работы продаются каждый год, тогда как большинство заказов выполняются с нуля. Найдите подходящий учебный материал на СтудИзбе!
Ответы на популярные вопросы
Да! Наши авторы собирают и выкладывают те работы, которые сдаются в Вашем учебном заведении ежегодно и уже проверены преподавателями.
Да! У нас любой человек может выложить любую учебную работу и зарабатывать на её продажах! Но каждый учебный материал публикуется только после тщательной проверки администрацией.
Вернём деньги! А если быть более точными, то автору даётся немного времени на исправление, а если не исправит или выйдет время, то вернём деньги в полном объёме!
Нет! Мы не выполняем работы на заказ, однако Вы можете попросить что-то выложить в наших социальных сетях.
Добавляйте материалы
и зарабатывайте!
Продажи идут автоматически
4123
Авторов
на СтудИзбе
667
Средний доход
с одного платного файла
Обучение Подробнее