PROGRAMA PRINCIPAL
PROGRAM Grafo;
USES
Cola;
CONST
MaxNodos = 5;
TYPE
TElem = String[30];
(* Grafo en memoria Estatica. *)
TamGrafo = 0..MaxNodos;
IndiceG = 1..MaxNodos;
TGrafoReg = RECORD
nodos : ARRAY[IndiceG] OF TElem;
arcos : ARRAY[IndiceG,IndiceG] OF Boolean;
tam : TamGrafo;
END;
GrafoEst = ^TGrafoReg;
(* Grafo en memoria Dinamica.*)
(* Posicion = ^NodoLista;
PuntArco = ^ArcoLista;
Arco = RECORD
nodo1, nodo2 : Posicion;
END;
NodoLista = RECORD
visitado : Boolean;
dato : TElem;
sig : Posicion;
prim : PuntArco;
END;
ArcoLista = RECORD
dato : Arco;
nodo : Posicion;
sig : PuntArco;
END;*)
GrafoDin = Posicion;
(* Devuelve la posicion de un nodo en un Grafo en memoria
estatica. Si no existe devuelve 0. *)
FUNCTION BuscaNodoEst(G : GrafoEst; Nom: TElem): Integer;
VAR
I : Integer;
Encontrado : Boolean;
BEGIN
Encontrado := False;
I := 0;
WHILE (I < MaxNodos) AND NOT Encontrado DO BEGIN
I := I + 1;
IF Nom = G^.nodos[I] THEN
Encontrado := True
END;
IF Encontrado THEN
BuscaNodoEst := I
ELSE BEGIN
Writeln('--- ERROR: El nombre no est en el GRAFO! ');
Writeln;
BuscaNodoEst := 0
END
END;
(* Imprime un Grafo en memoria Estatica *)
PROCEDURE ImprimeEst(G: GrafoEst);
VAR
I, J : Integer;
BEGIN
Writeln;
FOR I:=1 TO G^.tam DO BEGIN
Write(G^.nodos[I], ' ->');
FOR J:=1 TO G^.tam DO
Write(' ', G^.arcos[I, J]);
Writeln
END;
Writeln
END;
(* Insertamos un Nodo en un Grafo en memoria Estatica. *)
PROCEDURE InsNodoGEst(VAR G : GrafoEst);
VAR
Elemento : TElem;
I : Integer;
BEGIN
IF G^.tam = MaxNodos THEN BEGIN
Writeln('--- ERROR: Grafo lleno! ');
Writeln
END ELSE BEGIN
Write(' úIntroduce el nombre de la estacion : ');
Readln (Elemento);
G^.tam := G^.tam + 1;
FOR I:=1 TO G^.tam DO BEGIN
G^.arcos[G^.tam, I] := False;
G^.arcos[I, G^.tam] := False
END;
G^.nodos[G^.tam] := Elemento;
Writeln('--> Nodo introducido. ');
Writeln
END
END;
(* Insertamos un arco en un Grafo en memoria Estatica *)
PROCEDURE InsArcoGEst(VAR G : GrafoEst);
VAR
NodoA, NodoB : TElem;
BEGIN
Write(' úIntroduce Nodo A : '); Readln(NodoA);
Write(' úIntroduce Nodo B : '); Readln(NodoB);
IF (BuscaNodoEst(G, NodoA) = 0) OR (BuscaNodoEst(G, NodoB) = 0) THEN BEGIN
Writeln('--- ERROR: Al menos uno de los nodos no existe! ');
Writeln
END ELSE BEGIN
G^.arcos[BuscaNodoEst(G, NodoA), BuscaNodoEst(G, NodoB)] := True;
G^.arcos[BuscaNodoEst(G, NodoB), BuscaNodoEst(G, NodoA)] := True;
Writeln('--> Arco introducido. ');
Writeln
END
END;
(* Devuelve el nodo asociado al nombre introducido.
Si no existe devuelve NIL. *)
FUNCTION BuscaNodoGDin(GD : GrafoDin; E : TElem): Posicion;
VAR
Aux : Posicion;
Encontrado : Boolean;
BEGIN
Aux := GD;
Encontrado := False;
WHILE (Aux <> NIL) AND NOT Encontrado DO BEGIN
IF Aux^.dato = E THEN
Encontrado := True
ELSE
Aux := Aux^.sig
END;
IF NOT Encontrado THEN
Writeln('--- ERROR: El nombre no esta en el GRAFO!!! ');
BuscaNodoGDin := Aux
END;
(* Inserta un nodo en un Grafo en memoria Dinamica. *)
PROCEDURE InsNodoGDin(VAR GD: GrafoDin; E: TElem);
VAR
P : Posicion;
BEGIN
New(P);
P^.dato := E;
P^.sig := GD;
P^.prim := NIL;
P^.visitado := False;
GD := P
END;
(* Inserta un arco en un Grafo en memoria Dinamica. *)
PROCEDURE InsArcoGDin(VAR GD: GrafoDin; NA, NB: TElem);
VAR
A : Arco;
Tmp : PuntArco;
BEGIN
A.nodo1 := BuscaNodoGDin(GD, NA);
A.nodo2 := BuscaNodoGDin(GD, NB);
Tmp := A.nodo1^.prim;
New(A.nodo1^.prim);
A.nodo1^.prim^.nodo := A.nodo2;
A.nodo1^.prim^.sig := Tmp;
Tmp := A.nodo2^.prim;
New(A.nodo2^.prim);
A.nodo2^.prim^.nodo := A.nodo1;
A.nodo2^.prim^.sig := Tmp;
END;
(* Construye el Grafo en memoria Dinamica correspondiente a un
Grafo en memoria Estatica. *)
PROCEDURE GEst_GDin(G : GrafoEst; VAR GD : GrafoDin);
VAR
I, J : Integer;
BEGIN
FOR I:=1 TO G^.tam DO
InsNodoGDin(GD, G^.nodos[I]);
FOR I:=1 TO G^.tam DO BEGIN
FOR J:=1 TO G^.tam DO BEGIN
IF (J > I) AND (G^.arcos[I, J] = True) THEN
InsArcoGDin(GD, G^.nodos[I], G^.nodos[J])
END
END;
Writeln('---> El Grafo en memoria dinamica ha sido creado. ');
Writeln
END;
(* Muestra por pantalla los caminos de un nodo a los otros,
siendo los caminos minimos.
Es decir, realizar un recorrido en anchura. *)
PROCEDURE BreadthFirst(P: Posicion);
VAR
N, M : Posicion;
Q : TipoCola;
Actual : PuntArco;
Error : Boolean;
Orden : Integer;
BEGIN
Orden := 1;
CrearCola(Q);
Anyadir(Q, P, Orden);
P^.visitado := True;
Write(' NODO P = ', P^.dato);
WHILE NOT ColaVacia(Q) DO BEGIN
Cabeza(Q, N, Error);
Eliminar(Q, Error);
Actual := N^.prim;
WHILE Actual <> NIL DO BEGIN
M := Actual^.nodo;
IF NOT M^.visitado THEN BEGIN
Anyadir(Q, M, Orden);
M^.visitado := TRUE;
Write(' - ', M^.dato)
END;
Actual := Actual^.sig
END
END;
Writeln
END;
(* Muestra por pantalla los caminos de un nodo a los otros,
siendo los caminos minimos menores que 3. *)
PROCEDURE BreadthFirst2(P: Posicion);
VAR
N, M : Posicion;
Q : TipoCola;
Actual : PuntArco;
Error : Boolean;
Cont, NOrden : Integer;
BEGIN
CrearCola(Q);
NOrden := 1;
Anyadir(Q, P, NOrden);
P^.visitado := True;
Write(' NODO P = ', P^.dato);
WHILE NOT ColaVacia(Q) DO BEGIN
Cabeza(Q, N, Error);
Eliminar(Q, Error);
Actual := N^.prim;
NOrden := Orden(N) + 1;
WHILE (Actual <> NIL) DO BEGIN
M := Actual^.nodo;
IF NOT M^.visitado AND (NOrden <= 3) THEN BEGIN
Anyadir(Q, M, NOrden);
M^.visitado := TRUE;
Write(' - ', M^.dato);
END;
Actual := Actual^.sig
END
END;
Writeln
END;
VAR
G : GrafoEst;
GD : GrafoDin;
Opcion : Integer;
Elem : TElem;
BEGIN
New(G);
G^.tam := 0;
REPEAT
Writeln('------------- MENU PRINCIPAL ------------- ');
Writeln(' 1) Introduce Nodo en un Grafo Est tico. ');
Writeln(' 2) Introduce Arco en un Grafo Est tico. ');
Writeln(' 3) Visualizar Grafo Est tico. ');
Writeln(' 4) Convertir a Grafo Din mico. ');
Writeln(' 5) Caminos de un Nodo a otros. ');
Writeln(' 6) Caminos de Longitud < 3. ');
Writeln(' 7) Finalizar. ');
Writeln(' NOTA: Para que funcionen correctamente las opciones 4, 5 y 6');
Writeln(' solo deben ejecutarse una vez. ');
Write('Introduce opci¢n : '); Readln(Opcion);
Writeln;
CASE Opcion OF
1 : InsNodoGEst(G);
2 : InsArcoGEst(G);
3 : ImprimeEst(G);
4 : GEst_GDin(G, GD);
5 : BEGIN
Write('Introduce el nombre del Nodo : ');
Readln(Elem);
BreadthFirst(BuscaNodoGDin(GD, Elem));
Writeln
END;
6 : BEGIN
Write('Introduce el nombre del Nodo : ');
Readln(Elem);
BreadthFirst2(BuscaNodoGDin(GD, Elem));
Writeln
END
END
UNTIL Opcion = 7;
Writeln('<<< FIN DEL PROGRAMA >>>');
Dispose(G);
Readln
END.
UNIDAD Cola
UNIT Cola;
INTERFACE
TYPE
TElem = String[30];
Posicion = ^NodoLista;
PuntArco = ^ArcoLista;
Arco = RECORD
nodo1, nodo2 : Posicion;
END;
NodoLista = RECORD
visitado : Boolean;
dato : TElem;
sig : Posicion;
prim : PuntArco;
orden : Integer;
END;
ArcoLista = RECORD
dato : TElem;
nodo : Posicion;
sig : PuntArco;
END;
TipoPuntero = ^ElemCola;
ElemCola = RECORD
info : Posicion;
sig : TipoPuntero;
END;
TipoCola = RECORD
cabeza,
final : TipoPuntero
END;
PROCEDURE CrearCola (VAR Q: TipoCola);
FUNCTION ColaVacia (Q: TipoCola): Boolean;
PROCEDURE Cabeza (Q: TipoCola; VAR N: Posicion; VAR Error: Boolean);
PROCEDURE Anyadir (VAR Q: TipoCola; N: Posicion; O: Integer);
PROCEDURE Eliminar (VAR Q: TipoCola; VAR Error: Boolean);
FUNCTION Orden (P: Posicion): Integer;
IMPLEMENTATION
PROCEDURE CrearCola (VAR Q: TipoCola);
BEGIN
Q.cabeza := NIL;
Q.final := NIL
END;
FUNCTION ColaVacia (Q: TipoCola): Boolean;
BEGIN
ColaVacia := (Q.cabeza = NIL) AND (Q.final = NIL)
END;
PROCEDURE Cabeza (Q: TipoCola; VAR N: Posicion; VAR Error: Boolean);
BEGIN
IF ColaVacia(Q) THEN
Error := True
ELSE BEGIN
Error := False;
N := Q.cabeza^.info
END
END;
PROCEDURE Anyadir (VAR Q: TipoCola; N: Posicion; O: Integer);
VAR
Aux : TipoPuntero;
BEGIN
New(Aux);
N^.orden := O;
Aux^.info := N;
Aux^.sig := NIL;
IF ColaVacia(Q) THEN
Q.cabeza := Aux
ELSE
Q.final^.sig := Aux;
Q.final := Aux
END;
PROCEDURE Eliminar (VAR Q: TipoCola; VAR Error: Boolean);
VAR
Aux : TipoPuntero;
BEGIN
IF ColaVacia(Q) THEN
Error := True
ELSE BEGIN
Error := False;
Aux := Q.cabeza;
Q.cabeza := Aux^.sig;
IF (Q.cabeza = NIL) THEN
Q.final := NIL;
Dispose(Aux);
END
END;
FUNCTION Orden (P : Posicion): Integer;
BEGIN
Orden := P^.orden
END;
END.