Next
Previous
Contents
{* LIST - Listan kopiointia *}
program EsimLista;
import TRA;
procedure purge (L:LIST);
var p,q,r:LIST_POSITION;
begin
p := LIST_FIRST(L);
while (p<>LIST_EOL(L)) do
begin
q:=LIST_NEXT(L, p);
while (q<>LIST_EOL(L)) do
begin
if (LIST_SAME(L, LIST_RETRIEVE(L, p),
LIST_RETRIEVE(L, q))) then
begin
r := q;
q := LIST_NEXT(L, q);
LIST_DELETE(L, r);
end
else q:=LIST_NEXT(L, q);
end;
p := LIST_NEXT(L, p);
end;
end;
function Kopio (L: LIST) : LIST;
var
M : LIST;
p : LIST_POSITION;
BEGIN
LIST_CREATE(M, LIST_TYPE(L));
p := LIST_FIRST(L);
while (p<>NIL) DO BEGIN
LIST_INSERT(M, LIST_EOL(M), LIST_RETRIEVE(L, p));
p := LIST_NEXT(L, p);
END;
Kopio:=M;
END;
var
L, M:LIST;
begin
INT_LIST_CREATE(L);
LIST_CONSTRUCT_RANDOM(L, 20, 1, 10);
writeln('Lista L: ');LIST_PRINT(L);writeln;
writeln('Purge: ');writeln;
purge(L);
LIST_PRINT(L);
writeln;
writeln('Kopio: ');writeln;
M := Kopio(L);
LIST_PRINT(M);
LIST_FREE(M);
LIST_FREE(L);
end.
{* QUEUE - Jonon tulostus *}
program EsimJono;
import TRA;
procedure Tulosta (Q : QUEUE ; E: ELEMENT);
var
R, S : QUEUE;
begin
writeln('Alkuper,inen jono:');writeln;
QUEUE_PRINT(Q);
QUEUE_CREATE(R, QUEUE_TYPE(Q));
QUEUE_CREATE(S, QUEUE_TYPE(Q));
while (not( QUEUE_EMPTY(Q))) do begin
if (QUEUE_LESS(Q, QUEUE_FRONT(Q), E)) then begin
QUEUE_ENQUEUE(R, QUEUE_FRONT(Q));
end
else begin
QUEUE_ENQUEUE(S, QUEUE_FRONT(Q));
end;
QUEUE_DEQUEUE(Q);
end;
writeln; write('Jakoalkiota pienemm,t: ');
QUEUE_PRINT(R);
writeln; write('Jakoalkiota suuremmat tai yht, suuret: ');
QUEUE_PRINT(S);
writeln;
QUEUE_FREE(R);
QUEUE_FREE(S);
end;
{------------------------------------------main}
var
a : double;
Q : QUEUE;
begin
FLOAT_QUEUE_CREATE(Q);
QUEUE_CONSTRUCT_RANDOM(Q, 10, 1, 10);
writeln('Anna Jakoalkio : ');
readln(a);
Tulosta(Q, FLOAT_ELEMENT(a));
FQ_FREE(Q);
end.
{* STACK - Pinon tulostaminen. Sisältää perustoiminnot; alustaminen, lisäys
ja poisto, satunnainen luominen, vertailu, tulostus, tyypin
palauttaminen ja tyhjyyden vertailu.*}
program EsimPino;
import TRA;
procedure Tulosta (S : STACK; E : ELEMENT)
var
T, U : STACK;
begin
writeln('Alkuper,inen pino: ');
STACK_PRINT(S);
STACK_CREATE(T, STACK_TYPE(S));
STACK_CREATE(U, STACK_TYPE(S));
while ( not STACK_EMPTY(S)) do begin
if (STACK_LESS(S, STACK_TOP(S), E) or STACK_SAME(S, STACK_TOP(S), E)) then begin
STACK_PUSH(T, STACK_TOP(S));
end
else
STACK_PUSH(U, STACK_TOP(S));
STACK_POP(S);
end;
writeln('Jakoalkiota pienemm,t tai yht, suuret: ');
STACK_PRINT(T);
writeln(' Jakoalkiota suuremmat:');
STACK_PRINT(U);
writeln;
STACK_FREE(T);
STACK_FREE(U);
end; {Tulosta}
{.................................................. main}
var
S : STACK;
begin
IS_CREATE(S);
STACK_CONSTRUCT_RANDOM(S, 20, 1, 20);
writeln('Jakoalkio : 11');
Tulosta(S, INT_ELEMENT(11));
IS_FREE(S);
end.
{* DEQUEUE - Pakan tulostaminen. Sisältää perustoiminnot; alustaminen, lisäys
ja poisto, satunnainen luominen, vertailu, tulostus, tyypin
palauttaminen ja tyhjyyden vertailu.*}
program EsimPakka
import TRA;
procedure TulostaJaVaihda (DEQUE D);
var
ELEMENT E;
begin
if (DEQUE_EMPTY(D)) then begin
writeln('Pakka on tyhjä');
end
else begin
DEQUE_PRINT(D);
writeln('Vaihdetaan ensimmäinen ja viimeinen alkio: ');
E = DEQUE_FRONT(D);
DEQUE_DEQUEUE(D, top);
DEQUE_ENQUEUE(D, top, DEQUE_REAR(D));
DEQUE_DEQUEUE(D, bottom);
DEQUE_ENQUEUE(D, bottom, E);
DEQUE_PRINT(D);
end;
end;
var
DEQUE D;
begin
ID_CREATE(D);
DEQUE_CONSTRUCT_RANDOM(D, 10, 1, 10);
TulostaJaVaihda(D);
ID_FREE(D);
end.
(* TREE - Puun tulostaminen sisäjärjestyksessä *)
(* 9.9.1999 MM *)
(* main:issa luodaan seuraavanlainen puu: *)
(* 4 *)
(* / | \ *)
(* 5 6 8 *)
(* | *)
(* 7 *)
program EsimYpuu;
import TRA;
procedure preorder_print(T:TREE;n:TREE_NODE);
begin
TREE_PRINT_NODE(T, n);
writeln(' ');
n:=TREE_LEFTMOST_CHILD(T, n);
while (n<>NIL) do
begin
preorder_print(T, n);
n := TREE_RIGHT_SIBLING(T, n);
end;
end;
var T:TREE;
n,apu:TREE_NODE;
begin
INT_TREE_CREATE(T);
apu:=INT_TREE_CREATE_NODE(4);
TREE_ASSIGN_ROOT(T, apu);
TREE_ASSIGN_LEFTMOST_CHILD(T, TREE_ROOT(T),INT_TREE_CREATE_NODE(5));
n := TREE_LEFTMOST_CHILD(T, TREE_ROOT(T));
TREE_ASSIGN_RIGHT_SIBLING(T, n, INT_TREE_CREATE_NODE(6));
n := TREE_RIGHT_SIBLING(T, n);
TREE_ASSIGN_LEFTMOST_CHILD(T, n, INT_TREE_CREATE_NODE(7));
TREE_ASSIGN_RIGHT_SIBLING(T, n, INT_TREE_CREATE_NODE(8));
preorder_print(T, TREE_ROOT(T));
writeln;
end.
(* BTREE - Haku järjestetystä binääripuusta *)
(* 9.9.1999 MM *)
(* - Ratkaisussa jätetään vielä tuhoamatta puu. *)
(* - main():issa luodaan seuraavanlainen puu: *)
(* 4 *)
(* / \ *)
(* 2 8 *)
(* / \ / \ *)
(* 1 3 6 9 *)
program EsimBinPuu;
import TRA;
function binpuuhaku(T:BTREE; x:ELEMENT):boolean;
var n:BTREE_NODE;
loytyi:boolean;
begin
loytyi := false;
n := BTREE_ROOT(T);
while ((not loytyi) and (n<>NIL)) do
if (BTREE_SAME(T, BTREE_RETRIEVE(T, n), x)) then
loytyi := true
else
if (BTREE_LESS(T, x, BTREE_RETRIEVE(T, n))) then
n := BTREE_LEFTCHILD(T, n)
else
n := BTREE_RIGHTCHILD(T, n);
binpuuhaku:=loytyi;
end;
var T:BTREE;
apu,n:BTREE_NODE;
begin
INT_BTREE_CREATE(T);
apu:=INT_BTREE_CREATE_NODE(4);
BTREE_ASSIGN_ROOT(T,apu); (* Juuri *)
n := BTREE_ROOT(T);
BTREE_ASSIGN_CHILD(T, n, left, INT_BTREE_CREATE_NODE(2));
BTREE_ASSIGN_CHILD(T, n, right, INT_BTREE_CREATE_NODE(8));
n := BTREE_LEFTCHILD(T, BTREE_ROOT(T));
BTREE_ASSIGN_CHILD(T, n, left, INT_BTREE_CREATE_NODE(1));
BTREE_ASSIGN_CHILD(T, n, right, INT_BTREE_CREATE_NODE(3));
n := BTREE_RIGHTCHILD(T, BTREE_ROOT(T));
BTREE_ASSIGN_CHILD(T, n, left, INT_BTREE_CREATE_NODE(6));
BTREE_ASSIGN_CHILD(T, n, right, INT_BTREE_CREATE_NODE(9));
n := INT_BTREE_CREATE_NODE(9);
(* n osoittaa nyt "irtonaiseen" solmuun jonka nimi" on 9 *)
if (binpuuhaku(T, TREE_RETRIEVE(T, n))) then writeln('L"ytyy')
else writeln('Ei l"ydy');
end.
(*
Tietorakenteet ja algoritmit
Jarkko Rouvinen, 15.11.2001 JOUKKO esimerkki. Kolme aliohjelmaa.
1) Käydään joukko läpi ja lasketaan sen alkioden määrä.
2) Etsitään joukosta, jonka alkiot ovat joukkoja, pienialkioisin joukko.
3) Tulostetaan joukko, jonka alkiot ovat joukkoja
*)
program JOUKKO;
uses tra;
(*
1) Joukon perusläpikäynti; palautetaan joukon alkioden lukumäärä.
*)
function DSET_SIZE(A : DSET) : integer;
var i :DSET_ITERATOR;
x :ELEMENT;
lkm :integer;
begin
lkm:=0;
x:=DSET_ANY(A,i);
while (DSET_ITERATING(A,i)) do begin
lkm:=lkm+1;
x:=DSET_ANOTHER(A,i);
end;
DSET_SIZE:=lkm;
end; (* DSET_SIZE() *)
(*
2) Käydään läpi joukkoa, jonka alkiot ovat joukkoja. Edellistä aliohjelmaa käyttäen selvitetään
millä joukoista on vähiten alkoita ja palautetaan se, pienialkoisin joukko, aliohjelman lopussa.
*)
(* SJ 15.10.2002: poistettu toimimattomana *)
(*
3) Tulostetaan joukko, jonka alkiot ovat joukkoja.
*)
procedure DSET_DSET_PRINT(S : DSET);
var X : DSET;
i : DSET_ITERATOR;
begin
X := VOIDPTR_DSET_ANY(S, i);
while (DSET_ITERATING(S, i)) do begin
DSET_PRINT(X);
X := VOIDPTR_DSET_ANOTHER(S, i);
end;
end; (* DSET_DSET_PRINT() *)
(* pääohjelma *)
const N = 10; (* Joukon S joukkojen määrä *)
JM = 20; (* Joukon S joukkojen koko on väliltä 1-JM *)
M = 100; (* Joukon S joukkojen alkiot ovat välitä 1-M *)
var i, j, r : integer;
S, X : DSET;
begin
VOIDPTR_DSET_CREATE(S);
for i := 1 to N do begin
INT_DSET_CREATE(X);
r := random(JM)+1;
for j := 1 to r do
INT_DSET_INSERT(X, random(M));
VOIDPTR_DSET_INSERT(S, X);
end; (* for *)
writeln('Joukon S alkiot (kukin on joukko) ovat:');
DSET_DSET_PRINT(S);
writeln('Joukon S alkioiden lkm: ',DSET_SIZE(S));
writeln;
write('Alkioista pienin on joukko: ');
DSET_PRINT(DSET_DSET_MIN(S));
DSET_FREE(S);
end.
program Prioriteettijono;
(*
Tietorakenteet ja algoritmit
Jarkko Rouvinen 15.11.2001 PRIORITEETTIJONO esimerkki.
Etsitään k:nneksi suurin luku listasta prioriteettijonon avulla.
ELEMENT_INT() funktiosta on myös esimerkki.
*)
import TRA;
const N = 10;
(* Funktio luo prioriteettijonon ja laittaa siihen kaikki listan
alkiot, mutta siten että prioriteettijonossa on vain k kappaletta
alkoita kerrallaan. Määrän ylittyessä, poistaa se prioriteettijonon
pienimmän alkion. Kun lista on loppu, on prioriteettijonon
ensimmäisenä listan k:nneksi suurin alkio. oletus: ELEMENT = INT-tyyppiä
*)
function K_MAX(L: LIST; k: integer): ELEMENT;
var P: PRIQUEUE;
a: LIST_POSITION;
x: ELEMENT;
i: integer;
begin
i:=0;
PRIQUEUE_CREATE(P, LIST_TYPE(L)); (* luodaan L:n tyyppinen
prioriteettijono *)
a := LIST_FIRST(L);
while (a <> LIST_EOL(L)) do begin
x := LIST_RETRIEVE(L, a); (* palautuu ELEMENT *)
PRIQUEUE_INSERT(P, x, ELEMENT_INT(x)); (* Funktio "function ELEMENT_INT(ELEMENT E):INT" *)
i := i + 1; (* palauttaa elementin integer arvon (kokonaisluvun). *)
a := LIST_NEXT(L, a);
if (i <!---->> k) then
PRIQUEUE_DELETEMIN(P);
end;
x := PRIQUEUE_MIN(P);
PRIQUEUE_FREE(P); (* vapautetaan varattu tila *)
K_MAX:= x;
end;
(* pääohjelma *)
var l: LIST;
i: integer;
begin
INT_LIST_CREATE(l);
(* randomize;
for i:= 1 to N do
INT_LIST_INSERT(l, LIST_EOL(l), random(100) );*)
(* yllä olevat rivit voidaan korvata seuraavalla komennolla: *)
LIST_CONSTRUCT_RANDOM(l, N, 1, 100);
write('Lista: ');
LIST_PRINT(l);
writeln;
for i:= 1 to N do
writeln(i, '. suurin alkio: ', ELEMENT_INT(K_MAX(l, i)));
LIST_FREE(l);
end.
(* Tietorakenteet ja algoritmit, 2001
Jarkko Rouvinen 15.11.2001
SUUNNATTUVERKKO esimerkki. Tutkitaan rekursiivisesti, mitkä ovat solmun V seuraajat.
Kolme aliohjelmaa:
1) Rekursiivinen syvyyssuuntainen etsintä, jossa läpikäydyt solmut kerätään joukkoon.
2) Startti edelliselle
3) Tulostetaan joukko, jonka alkiot ovat verkon solmuja.
*)
program Suunnattuverkko;
import TRA;
(*
Rekursiivinen syvyyssuuntainen etsintä.
Kerätään rekursiiviseti solmut, jotka ovat solmun "V" naapureita, joukkoon
"Joukko", siis edetään verkossa kaikkialle, minne päästään.
*)
procedure seuraajat_rek(var Joukko: DSET; G :DIGRAPH; V:DIGRAPH_VERTEX);
var vi :DIGRAPH_VERTEX_ITERATOR;
W :DIGRAPH_VERTEX;begin
DIGRAPH_ASSIGN_VERTEX_COLOR(G, V, DIGRAPH_GRAY);
VOIDPTR_DSET_INSERT(Joukko, V); (* solmu joukkoon *)
(* käydään tämän solmun kaikki naapurit *)
W := DIGRAPH_VERTEX_ANY_ADJ(G, V, vi);
while (DIGRAPH_VERTEX_ITERATING_ADJ(G, V, vi)) do begin
if (DIGRAPH_VERTEX_COLOR(G, W)= DIGRAPH_WHITE) then
seuraajat_rek(Joukko, G, W); (* ja taas näiden naapurit
*)
W := DIGRAPH_VERTEX_ANOTHER_ADJ(G, V, vi);
end;
end;
(* startti edelliselle.
väritetään aluksi verkon joka solmu valkoiseksi, jonka jälkeen
käynnistetään "seuraajat_rek" kaikilla solmun "V_alku" naapureilla.
*)
function seuraajat_startti(G :DIGRAPH; V_Alku :DIGRAPH_VERTEX): DSET;
var Joukko :DSET;
vi :DIGRAPH_VERTEX_ITERATOR;
V :DIGRAPH_VERTEX;
begin
VOIDPTR_DSET_CREATE(Joukko);
(* Kaikki valkoisiksi *)
V := DIGRAPH_VERTEX_ANY(G, vi);
while (DIGRAPH_VERTEX_ITERATING(G, vi)) do begin
DIGRAPH_ASSIGN_VERTEX_COLOR(G, V, DIGRAPH_WHITE);
V := DIGRAPH_VERTEX_ANOTHER(G, vi);
end;
(* käydään solmun V_alku kaikki naapurit *)
V := DIGRAPH_VERTEX_ANY_ADJ(G, V_Alku, vi);
while (DIGRAPH_VERTEX_ITERATING_ADJ(G, V_Alku, vi)) do begin
if (DIGRAPH_VERTEX_COLOR(G, V) = DIGRAPH_WHITE) then
seuraajat_rek(Joukko, G, V); (* käydään naapurin naapurit *)
V:= DIGRAPH_VERTEX_ANOTHER_ADJ(G, V_Alku, vi);
end;
return Joukko;
end;
(* Tulostaa joukon "S" alkiot, jotka ovat verkon "G" solmuja.
Joukon perusläpikäynti, siten että alkiot ovat osoittimia.
*)
procedure Tulosta_solmut_joukosta( G :GRAPH; S :DSET);
var V :DIVERTEX;
i :DSET_ITERATOR;
begin
V := PDS_ANY(S, i);
while (PDS_ITERATING(S, i)) do begin
write(DIGRAPH_VERTEX_LABEL(G, V), ' ');
V := PDS_ANOTHER(S, i);
end;
writeln;
VOIDPTR_DSET_FREE(S);
end;
var G: DIGRAPH;
V: DIGRAPH_VERTEX;
V_APU: array [1..8] of DIGRAPH_VERTEX;
E: DIGRAPH_EDGE;
ei: DIGRAPH_EDGE_ITERATOR;
vi: DIGRAPH_VERTEX_ITERATOR;
begin
DIGRAPH_CREATE(G);
(* luodaan verkkoa... *)
V_APU[1] := DIGRAPH_INSERT_VERTEX(G, 'Eka',0,DIGRAPH_WHITE);
V_APU[2] := DIGRAPH_INSERT_VERTEX(G, 'Toka',0,DIGRAPH_WHITE);
V_APU[3] := DIGRAPH_INSERT_VERTEX(G, 'Kolmas',0,DIGRAPH_WHITE);
V_APU[4] := DIGRAPH_INSERT_VERTEX(G, 'Neljäs',0,DIGRAPH_WHITE);
V_APU[5] := DIGRAPH_INSERT_VERTEX(G, 'Viides',0,DIGRAPH_WHITE);
V_APU[6] := DIGRAPH_INSERT_VERTEX(G, 'Kuudes',0, DIGRAPH_WHITE);
V_APU[7] := DIGRAPH_INSERT_VERTEX(G, 'Seiska',0, DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[1], V_APU[2], 'Kaari 1-2',5,DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[2], V_APU[3], 'Kaari 2-3',3,DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[2], V_APU[4], 'Kaari 2-4',2,DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[6], V_APU[5], 'Kaari 6-5',2,DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[4], V_APU[7], 'Kaari 4-7',2,DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[3], V_APU[6], 'Kaari 3-6',2,DIGRAPH_WHITE);
DIGRAPH_INSERT_EDGE(G, V_APU[5], V_APU[2], 'Kaari 5-2',2,DIGRAPH_WHITE);
writeln('Verkko on:');
writeln(' 4------>7 ');
writeln(' ^ ');
writeln(' | ');
writeln('1-->2-->3-->6 ');
writeln(' ^ | ');
writeln(' | | ');
writeln(' 5<------+ ');
writeln;
write('1:n seuraajat : ');
Tulosta_solmut_joukosta(G, seuraajat_startti(G, V_APU[1]));
write('2:n seuraajat : ');
Tulosta_solmut_joukosta(G, seuraajat_startti(G, V_APU[2]));
write('4:n seuraajat : ');
Tulosta_solmut_joukosta(G, seuraajat_startti(G, V_APU[4]));
write('6:n seuraajat : ');
Tulosta_solmut_joukosta(G, seuraajat_startti(G, V_APU[6]));
DIGRAPH_FREE(G);
end.
(* Tietorakenteet ja algoritmit, 2001
Jarkko Rouvinen 15.11.2001
SUUNTAAMATON VERKKO esimerkki. Tutkitaan rekursiivisesti, onko suuntaamattomassa verkossa kehää.
Kolme aliohjelmaa:
1) Väritetään verkon kaikki solmut halutulla numerolla tai tietorakennekirjaston värillä.
2) Verkon rekursiivinen syvyyssuuntainen läpikäynti.
3) Startti edelliselle.
*)
program Suuntaamaton_verkko;
uses TRA;
(* alustaa suuntaamattoman verkon integer-luvulla. Myös tietorakennekirjaston verkon värit ovat lukuja,
joten tätä voidaan kutsua vaikkapa " Alusta_Verkko(G, GRAPH_WHITE); ".
*)
procedure Alusta_Verkko (G :GRAPH; alustaja :integer);
var V: GRAPH_VERTEX;
vi: GRAPH_VERTEX_ITERATOR;
begin
V := GRAPH_VERTEX_ANY(G, vi);
while (GRAPH_VERTEX_ITERATING(G, vi)) do begin
GRAPH_ASSIGN_VERTEX_COLOR(G, V, alustaja);
V := GRAPH_VERTEX_ANOTHER(G, vi);
end;
end; (* Alusta_Verkko *)
(*
Käydään verkkoa läpi rekursiiviseti ja tarkastetaan ettei siinä ole kehää.
Käydään solmusta V_alku lähtien yhtenäinen osuus verkosta läpi ja väritetään
solmuja käyntijärjestyksessä. Jos tavataan jo väritetty solmu (eli siinä on käyty jo aiemmin),
verkossa on kehä. "V_tulo" on solmu, josta tähän kutsuun tultiin, joten siihen ei saa
mennä uudestaan.
*)
function Keha (G: GRAPH; V_alku, V_Tulo: GRAPH_VERTEX): boolean;
var vi :GRAPH_VERTEX_ITERATOR;
W :GRAPH_VERTEX;
aiemmin_kayty :boolean;
begin
aiemmin_kayty:= false;
GRAPH_ASSIGN_VERTEX_COLOR(G, V_alku, GRAPH_GRAY);
(* käydään läpi solmun V_alku kaikki naapurit *)
W := GRAPH_VERTEX_ANY_ADJ(G, V_alku, vi);
while (not aiemmin_kayty and GRAPH_VERTEX_ITERATING_ADJ(G, V_alku, vi)) do begin
if (W <<!---->> V_Tulo) then begin (* ei mennä sinne mistä tultiin *)
if GRAPH_VERTEX_COLOR(G, W) = GRAPH_GRAY then
aiemmin_kayty:= true
else if ( Keha(G, W, V_alku) ) then (* käydään solmun W naapurit *)
aiemmin_kayty:= true;
end; W := GRAPH_VERTEX_ANOTHER_ADJ(G, V_alku, vi);
end;
keha:= aiemmin_kayty;
end;
(* startti kehän etsinnälle.
Käydään verkkon joka solmu läpi ja aina valkoisen solmun löytyessä käynnistetään
edellinen aliohjelma ( Keha ). Pelkkä yksi Kehan suoritus ei riitä, sillä verkko
ei ole välttämättä yhtenäinen.
*)
function Verkossa_Keha(G :GRAPH): boolean;
var vi :GRAPH_VERTEX_ITERATOR;
V :GRAPH_VERTEX;
loytyi :boolean;
begin
loytyi:= false;
Alusta_Verkko(G, GRAPH_WHITE); V := GRAPH_VERTEX_ANY(G, vi);
(* kunnes verkon joka solmussa on käyty ja ei ole löytynyt harmaata seuraaja solmua *)
while (not loytyi and GRAPH_VERTEX_ITERATING(G, vi)) do begin
if GRAPH_VERTEX_COLOR(G, V) = GRAPH_WHITE then
if ( Keha(G, V, V) ) then
(* käydään tämän valkean solmun seuraajat *)
loytyi:= true;
V := GRAPH_VERTEX_ANOTHER(G, vi);
end;
Verkossa_Keha:= loytyi;
end;
(* PÄÄOHJELMA *)
var G :GRAPH;
V_APU : array [1..6] of GRAPH_VERTEX;
i: integer;
begin
(* Luodaan verkkoa... *)
GRAPH_CREATE(G);
V_APU[1] := GRAPH_INSERT_VERTEX(G, 'Eka', 0, 0);
V_APU[2] := GRAPH_INSERT_VERTEX(G, 'Toka', 0, 0);
V_APU[3] := GRAPH_INSERT_VERTEX(G, 'Kolmas', 0, 0);
V_APU[4] := GRAPH_INSERT_VERTEX(G, 'Neljäs', 0, 0);
V_APU[5] := GRAPH_INSERT_VERTEX(G, 'Viides', 0, 0);
V_APU[6] := GRAPH_INSERT_VERTEX(G, 'Kuudes', 0, 0);
GRAPH_INSERT_EDGE(G, V_APU[1], V_APU[2], 'Kaari 1-2', 5, 0);
GRAPH_INSERT_EDGE(G, V_APU[2], V_APU[3], 'Kaari 2-3', 3, 0);
GRAPH_INSERT_EDGE(G, V_APU[2], V_APU[4], 'Kaari 2-4', 2, 0);
GRAPH_INSERT_EDGE(G, V_APU[2], V_APU[5], 'Kaari 2-5', 1, 0);
GRAPH_INSERT_EDGE(G, V_APU[3], V_APU[6], 'Kaari 3-6', 6, 0);
writeln('Verkko:');
writeln(' 4 ');
writeln(' | ');
writeln(' | ');
writeln('1--2--3--6 ');
writeln(' | ');
writeln(' | ');
writeln(' 5 ');
if ( Verkossa_Keha(G) ) then
writeln('Verkossa on kehä!')
else writeln('Verkossa ei ole kehää.');
(* muodostetaan verkkoon kehä *)
GRAPH_INSERT_EDGE(G, V_APU[1], V_APU[4] , 'Kaari 1-4', 2, 0);
GRAPH_INSERT_EDGE(G, V_APU[1], V_APU[5] , 'Kaari 1-5', 6, 0);
writeln;
writeln('Uudistettu verkko:');
writeln(' 4 ');
writeln(' / | ');
writeln(' / | ');
writeln('1---2--3--6 ');
writeln(' \ | ');
writeln(' \ | ');
writeln(' 5 ');
if ( Verkossa_Keha(G) ) then
writeln('Verkossa on kehä!')
else writeln('Verkossa ei ole kehää.');
end.
Next
Previous
Contents