Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- UNIT uGrafoEstatica;
- INTERFACE
- USES uElem,uConj,uCola;
- CONST
- MAX = 5;
- TYPE
- TAlmacen = RECORD
- e:TElem;
- b:boolean;
- END;
- TMatriz = ARRAY[1..MAX , 1..MAX] OF integer;
- TVector = ARRAY [1..MAX] OF TAlmacen;
- TGrafo = RECORD
- matriz:TMatriz;
- vector:TVector;
- tope:0..MAX;
- END;
- PROCEDURE CrearGrafoVacio (VAR grafo:TGrafo);
- PROCEDURE Insertar (VAR grafo:TGrafo; e:TElem);
- PROCEDURE InsertarArco (VAR grafo:TGrafo; o,d:TElem);
- PROCEDURE Pertenece (vector:TVector; VAR bo:boolean; VAR po:1..MAX);
- PROCEDURE EliminarVertice (VAR grafo:TGrafo; e:TElem);
- PROCEDURE EliminarArco (VAR grafo:TGrafo; o,d:TElem);
- PROCEDURE RecorridoAnchura (grafo:TGrafo);
- IMPLEMENTATION
- PROCEDURE CrearGrafoVacio (VAR grafo:TGrafo);
- VAR
- i,j:0..MAX
- BEGIN
- FOR i:=1 TO MAX DO
- FOR j:=1 TO MAX DO
- grafo.matriz[i,j] := 0;
- FOR i:=1 TO MAX DO
- grafo.vector[i].b := FALSE;
- grafo.tope := 0;
- END;
- PROCEDURE Insertar (VAR grafo:TGrafo; e:TElem);
- VAR
- b:boolean;
- p:0..MAX;
- BEGIN
- p := 0;
- Pertenece(e,grafo.vector,grafo,b,p);
- IF (grafo.tope < MAX) AND (b=FALSE) THEN
- BEGIN
- grafo.tope := grafo.tope + 1;
- grafo.vector[grafo.tope].b := TRUE;
- Asignar(grafo.vector[grafo.tope].e , e);
- END;
- END;
- PROCEDURE InsertarArco (VAR grafo:TGrafo; o,d:TElem);
- VAR
- pos,pos2:1..MAX;
- b,b2:boolean;
- BEGIN
- pos := 0;
- pos2 := 0;
- Pertenece(o,grafo.vector,grafo,b,pos);
- Pertenece(d,grafo.vector,grafo,b2,pos2);
- IF (b) AND (b2) THEN
- BEGIN
- grafo.matriz[pos,pos2] := 1;
- END;
- END;
- PROCEDURE Pertenece (elem:TElem; vector:TVector; grafo:TGrafo; VAR bo:boolean; VAR po:1..MAX);
- VAR
- i:1..MAX;
- BEGIN
- bo := FALSE;
- IF grafo.tope<>0 THEN
- BEGIN
- i := 1;
- WHILE (i<=grafo.tope) AND (bo=FALSE) DO
- BEGIN
- bo := ( Iguales(vector[i].e , elem) ) AND (vector[i].b);
- i := i+1;
- END;
- po := i;
- END;
- END;
- PROCEDURE EliminarVertice (VAR grafo:TGrafo; e:TElem);
- VAR
- p:0..MAX;
- b:boolean;
- i:1..MAX;
- BEGIN
- p := 0;
- Pertenece(e,grafo.vector,grafo,b,p);
- IF b THEN
- BEGIN
- grafo.vector[p].b := FALSE;
- FOR i:=1 TO grafo.tope DO
- BEGIN
- grafo.matriz[p,i] := 0;
- grafo.matriz[i,p] := 0;
- END;
- END;
- END;
- PROCEDURE EliminarArco (VAR grafo:TGrafo; o,d:TElem);
- VAR
- b,b2:boolean;
- p,p2:0..MAX;
- BEGIN
- Pertenece(o,grafo.vector,grafo,b,p);
- Pertenece(d,grafo.vector,grafo,b2,p2);
- IF b AND b2 THEN
- grafo.matriz[p,p2] := 0;
- END;
- PROCEDURE RecorridoAnchura (grafo:TGrafo);
- VAR
- conjR,conjV,conjD:TConj;
- i,po:integer;
- bo:boolean;
- elem:TElem;
- BEGIN
- CrearConjuntoVacio(conjV);
- CrearConjuntoVacio(conjR);
- FOR i=1 TO MAX DO
- BEGIN
- IF grafo.vector[i].b=TRUE THEN
- Poner(conjV,grafo.vector[i].e);
- END;
- i:=1;
- WHILE (grafo.vector[i].b<>FALSE) AND (i<=grafo.tope) DO
- BEGIN
- i := i+1;
- END;
- IF grafo.vector[i].b = TRUE THEN
- BEGIN
- Mostrar(grafo.vector[i].e);
- Poner(conjR,grafo.vector[i].e);
- CrearColaVacia(cola);
- FOR j:=1 TO grafo.tope DO
- BEGIN
- IF grafo.matriz[i,j]=1 THEN
- InsertarCola(cola,grafo.vector[j].e);
- END;
- WHILE NOT(EsColaVacia(cola)) DO
- BEGIN
- PrimeroCola(cola,elem);
- Mostrar(elem);
- Poner(conjR,elem);
- po := 0;
- Pertenece(elem,grafo.vector,grafo,bo,po);
- FOR j:=1 TO grafo.tope DO
- BEGIN
- IF (grafo.matriz[po,j]=1) AND NOT(uCola.Pertenece(cola,grafo.vector[j].e)) THEN
- InsertarCola(cola,grafo.vector[j].e);
- END;
- uCola.Quitar(cola);
- END;
- END;
- END;
- END.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement