Программа формирования списка дуг ориентированного мультиграфа с петлями по заданной матрице инцидентности

Автор: Пользователь скрыл имя, 29 Февраля 2012 в 23:01, курсовая работа

Описание работы

Ориентированный мультиграф с петлями G=(X,U), где Х-множество вершин графа, U- множество дуг графа, задан матрицей инцидентности МI.Сформировать список дуг графа. По сформированному списку дуг определить степени исхода всех вершин графа. Упорядочит номера вершин по возрастанию значений их степеней исхода. Удалить из списка дуг все дуги, исходящие из вершины с максимальной степенью исхода и имеющий петли.

Скачать полностью (36.48 Кб) Сколько стоит заказать работу?

Работа содержит 1 файл

Курсовой проект.doc

— 200.50 Кб (Скачать)

Список дуг:

2 1 4 1 1 2 4 2 2 2 2 3 4 3 2 3

Вершина=2 имеет максимальную степень=4

Ориентированный мультиграф:

Список дуг после удаления:

4 1 1 2 4 2 4 3

Ориентированный мультиграф после удаления:

Приложение

ТЕКСТ ПРОГРАММЫ

Program Course_1;

uses crt,graph;

Type

T=^elem;

elem=record

natchalo,konec:integer;

adr:T;

end;

Var First:T;

MI:array[1..10,1..20] of integer;

md:array[1..100] of byte;

Vmax,n,d,i,j:byte;

f:text;

filename:string[12];

sym:char;

PROCEDURE FORMI(x:integer);

Var i:byte;

tu:T;

x1,y:integer;

st:string;

Begin

n:=0;

Reset(f);

i:=0;

while not eof(f) do

begin

inc(i); j:=0;

while not Eoln(f) do

begin

inc(j);

read(f,MI[i,j]);

end;

readln(f);

d:=j;

end;

n:=i;

str(n,st);

outtextxy(10,450,'Kol-vo vershin='+st);

y:=65;

outtextxy(10,60,'Matrica incidentnosti');

tu:=First;

for i:=1 to n do

begin

x1:=x; y:=y+15;

for j:=1 to d do

begin

str(MI[i,j],st);

outtextxy(x1,y,st);

x1:=x1+22;

end;

PROCEDURE INITGR;

Var gd,gm,err:integer;

Begin

gd:=detect;

INITGRAPH(gd,gm,' ');

err:=GraphResult;

if err<>0 then

begin

writeln('Error');

halt;

end;

End;

PROCEDURE RISMENU;

Begin

setfillstyle(1,2);

bar(1,1,640,480);

setfillstyle(1,green);

bar(5,5,635,50);

setfillstyle(1,red);

bar(5,55,315,475);

bar(325,55,635,475);

setcolor(black);

outtextxy(250,10,'MENU');

outtextxy(40,20,'1-Vvod matricy incidentnosti');

outtextxy(300,20,'2-Udalenie dug');

outtextxy(450,20,'3-Exit');

End;

PROCEDURE FORMD(x,y:integer);

Var tu,pu:T;

x1,y1:integer;

st:string;

i,j,k:byte;

Begin

new(tu);

first:=tu;

for i:=1 to n do

for j:=1 to d do

begin

if MI[i,j]=1 then

begin

for k:=1 to n do

If MI[k,j]=-1 then

begin

tu^.natchalo:=k;

tu^.konec:=i;

pu:=tu;

new(tu);

pu^.adr:=tu;

end;

if Mi[i,j]=2 then

begin

tu^.natchalo:=i;

tu^.konec:=i;

pu:=tu;

New(tu);

pu^.adr:=tu;

end;

pu^.adr:=nil;

str(d,st);

outtextxy(10,465,'Kol-vo dug='+st);

outtextxy(x,y,'Spisok dug');

y1:=y+15;

tu:=first;

x1:=x;

while tu<>nil do

begin

if x1>300 then

begin

x1:=x;

y1:=y1+15;

end;

str(tu^.natchalo,st);

outtextxy(x1,y1,st);

x1:=x1+10;

str(tu^.konec,st);

outtextxy(x1,y1,st);

tu:=tu^.adr;

x1:=x1+15;

end;

PROCEDURE STEPEN;

var tu,pu:T;

A,C:array[1..10] of byte;

k,max,m,b,j:byte;

key,false,true:boolean;

x:integer;

st,st0,st1,st2:string;

begin

for i:=1 to n do

begin

A[i]:=0;

c[i]:=0;

end;

tu:=first; m:=0;

for i:=1 to n do

begin

while tu<>nil do

begin

if tu^.natchalo=i then

begin

m:=m+1;

tu:=tu^.adr;

end

else

tu:=tu^.adr;

a[i]:=m;

end;

tu:=first;

m:=0;

c[i]:=i;

end;

for j:=1 to n do

repeat

key:=false;

for i:=1 to n-1 do

if a[i]>a[i+1] then

begin

key:=true;

b:=a[i];

a[i]:=a[i+1];

a[i+1]:=b;

b:=c[i];

c[i]:=c[i+1];

c[i+1]:=b;

end;

until key=false;

x:=200;

setcolor(black);

outtextxy(x-5,70,'Stepeni vershin');

outtextxy(x-10,80,'Nomer');

outtextxy(x-10,95,'Step');

for i:=1 to n do

begin

str(c[i],st0);

outtextxy(x+50,80,st0);

str(A[i],st);

outtextxy(x+50,95,st);

x:=x+15;

end;

max:=A[1];

Vmax:=c[1];

for i:=2 to n do

if a[i]>max then

begin

max:=a[i];

Vmax:=c[i];

end;

str(Vmax,st1); str(max,st2);

outtextxy(190,110,'Vmax - '+st1);

outtextxy(190,125,'Max - '+st2);

end;

PROCEDURE DELETE;

var tu,pu:T; x,y,x1,y1:integer;

st:string;

begin

tu:=first;

while tu<>nil do

begin

if (tu^.natchalo=Vmax)or(tu^.natchalo=tu^.konec) then

begin

if tu=first then

first:=tu^.adr

else

begin

pu^.adr:=tu^.adr;

tu:=pu;

end;

pu:=tu;

tu:=tu^.adr;

end;

x:=340; y:=70;

outtextxy(x,y,'Spisok dug posle udaleniya');

y1:=y+15;

tu:=first;

x1:=x;

while tu<>nil do

begin

if x1>610 then

begin

x1:=x;

y1:=y1+15;

end;

str(tu^.natchalo,st);

outtextxy(x1,y1,st);

x1:=x1+10;

str(tu^.konec,st);

outtextxy(x1,y1,st);

tu:=tu^.adr;

x1:=x1+15;

end;

PROCEDURE RISGRAF(x:integer);

var

xk,yk,xkv,ykv:array[1..10] of integer;

i,j:byte;

tu:T;

st1,st2:string;

xc,yc,xs,ys,y:integer;

a:real;

begin

a:=2*pi/n;

for i:=1 to n do

begin

setcolor(1);

xk[i]:=round(95*cos(a*i)+x+120)-75;

yk[i]:=round(95*sin(a*i)+140+120)+20;

xkv[i]:=round(110*cos(a*i)+x+120)-75;

ykv[i]:=round(110*sin(a*i)+140+120)+20;

setcolor(yellow);

circle(xk[i],yk[i],2);

str(i,st1);

outtextxy(xkv[i],ykv[i],st1);

end;

y:=150;

tu:=first;

while tu<>nil do

begin

for i:=1 to n do

for j:=1 to n do

if (tu^.natchalo=i)and(tu^.konec=j) then

begin

setcolor(1);

str(tu^.natchalo,st1);

str(tu^.konec,st2);

if(tu^.natchalo=tu^.konec) then

circle(xk[i],yk[i],8);

setlinestyle(0,0,1);

line(xk[i],yk[i],xk[j],yk[j]);

setcolor(5);

xc:=(xk[i]+xk[j])div 2;

yc:=(yk[i]+yk[j])div 2;

xs:=(xc+xk[j])div 2;

ys:=(yc+yk[j])div 2;

setlinestyle(0,0,3);

line(xs,ys,xk[j],yk[j]);

setcolor(4);

tu:=tu^.adr;

end;

BEGIN

writeln('Vvedite filename');

readln(filename);

assign(f,filename);

initgr;

rismenu;

repeat

sym:=readkey;

case sym of

'1':

begin

FORMI(10);

FORMD(10,420);

RISGRAF(100);

end;

'2':

begin

STEPEN;

DELETE;

RISGRAF(420);

end;

'3':halt;

end;

until sym=#27;

readkey;

closegraph;

end.

Информация о работе Программа формирования списка дуг ориентированного мультиграфа с петлями по заданной матрице инцидентности